Theory ListAux

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section ‹Basic Functions Old and New›

theory ListAux
imports Main
begin

declare Let_def[simp]

subsection ‹HOL›

lemma pairD:  "(a,b) = p  a = fst p  b = snd p"
by auto


lemmas conj_aci = conj_comms conj_assoc conj_absorb conj_left_absorb

definition enum :: "nat  nat set" where
  [code_abbrev]: "enum n = {..<n}"

lemma [code]:
  "enum 0 = {}"
  "enum (Suc n) = insert n (enum n)"
  unfolding enum_def lessThan_0 lessThan_Suc by rule+


subsection ‹Lists›

declare List.member_def[simp] list_all_iff[simp] list_ex_iff[simp]


subsubsectionlength›

notation length  ("|_|")

lemma length3D: "|xs| = 3  x y z. xs = [x, y, z]"
apply (cases xs) apply simp
apply (case_tac list) apply simp
apply (case_tac lista) by simp_all

lemma length4D: "|xs| = 4   a b c d. xs = [a, b, c, d]"
 apply (case_tac xs) apply simp
 apply (case_tac list) apply simp
 apply (case_tac lista) apply simp
 apply (case_tac listb) by simp_all


subsubsection @{const filter}

lemma filter_emptyE[dest]: "(filter P xs = [])   x  set xs   ¬ P x" 
  by (simp add: filter_empty_conv)

lemma filter_comm: "[x  xs. P x  Q x] = [x  xs. Q x  P x]"
  by (simp add: conj_aci)

lemma filter_prop: "x  set [uys . P u]  P x"
proof (induct ys arbitrary: x)
  case Nil then show ?case by simp 
next 
  case Cons then show ?case by (auto split: if_split_asm)
qed
   
lemma filter_compl1: 
 "([xxs. P x] = []) = ([xxs. ¬ P x] = xs)" (is "?lhs = ?rhs")
proof
  show "?rhs  ?lhs" 
  proof (induct xs) 
    case Nil then show ?case by simp
  next
    case (Cons x xs) 
    have "[uxs . ¬ P u]  x # xs"
    proof 
      assume "[uxs . ¬ P u] = x # xs" 
      then have "|x # xs| = |[uxs . ¬ P u]|" by simp
      also have "...  |xs|" by simp 
      finally show False by simp 
    qed
    with Cons show ?case by auto  
  qed
next
  show "?lhs  ?rhs" 
    by (induct xs) (simp_all split: if_split_asm)
qed
lemma [simp]: "Not  (Not  P) = P"
  by (rule ext) simp

lemma filter_eqI: 
  "(v. v  set vs  P v = Q v)  [vvs . P v] = [vvs . Q v]"
  by (induct vs) simp_all

lemma filter_simp: "(x. x  set xs  P x)  [xxs. P x  Q x] = [xxs. Q x]"
 by (induct xs) auto

lemma filter_True_eq1: 
  "(length [yxs. P y] = length xs)  (y. y  set xs  P y)"
proof (induct xs)
  case Nil then show ?case by simp
next
  case (Cons x xs)
  have l: "length (filter P xs)  length xs"
    by (simp add: length_filter_le)
  have hyp: "length (filter P (x # xs)) = length (x # xs)" by fact
  then have "P x"  by (simp split: if_split_asm) (insert l, arith)
  moreover with hyp have "length (filter P xs) = length xs" 
    by (simp split: if_split_asm)
  moreover have "y  set (x#xs)" by fact
  ultimately show ?case by (auto dest: Cons(1))
qed

lemma [simp]: "[f x. x <- xs, P x] = [f x. x <- [x  xs. P x]]"
  by (induct xs) auto


subsubsection @{const concat}

syntax
  "_concat" :: "idt  'a list  'a list  'a list"  ("⨆⇘_ _ _" 10)
translations
  "⨆xxs f" == "CONST concat [f. x <- xs]" 


subsubsection ‹List product›

definition listProd1 :: "'a  'b list  ('a × 'b) list" where
 "listProd1 a bs  [(a,b). b <- bs]"

definition listProd :: "'a list  'b list  ('a × 'b) list" (infix "×" 50) where
 "as × bs a  as listProd1 a bs"

lemma(*<*)[simp]: (*>*) "set (xs × ys) = (set xs) × (set ys)" 
  by (auto simp: listProd_def listProd1_def)


subsubsection ‹Minimum and maximum›

primrec minimal:: "('a  nat)  'a list  'a" where
 "minimal m (x#xs) =
  (if xs=[] then x else
   let mxs = minimal m xs in
   if m x  m mxs then x else mxs)"


lemma minimal_in_set[simp]: "xs  []  minimal f xs : set xs"
by(induct xs) auto

primrec min_list :: "nat list  nat" where
  "min_list (x#xs) = (if xs=[] then x else min x (min_list xs))"

primrec max_list :: "nat list  nat" where
  "max_list (x#xs) = (if xs=[] then x else max x (max_list xs))"


lemma min_list_conv_Min[simp]:
 "xs  []  min_list xs = Min (set xs)"
by (induct xs) auto

lemma max_list_conv_Max[simp]:
 "xs  []  max_list xs = Max (set xs)"
by (induct xs) auto


subsubsection ‹replace›

primrec replace :: "'a  'a list  'a list   'a list" where
  "replace x ys [] = []"
| "replace x ys (z#zs) = 
     (if z = x then ys @ zs else z # (replace x ys zs))"

primrec mapAt :: "nat list  ('a  'a)  ('a list  'a list)" where
  "mapAt [] f as = as"
| "mapAt (n#ns) f as = 
     (if n < |as| then mapAt ns f (as[n:= f (as!n)])
     else mapAt ns f as)"


lemma length_mapAt[simp]: "xs. length(mapAt vs f xs) = length xs"
by(induct vs) auto

lemma length_replace1[simp]: "length(replace x [y] xs) = length xs"
by(induct xs) simp_all

lemma replace_id[simp]: "replace x [x] xs = xs"
by(induct xs) simp_all

lemma len_replace_ge_same:
"length ys  1  length(replace x ys xs)  length xs"
by (induct xs) auto

lemma len_replace_ge[simp]:
" length ys  1; length xs  length zs  
 length(replace x ys xs)  length zs"
apply(drule len_replace_ge_same[where x = x and xs = xs])
apply arith
done


lemma replace_append[simp]:
  "replace x ys (as @ bs) =
   (if x  set as then replace x ys as @ bs else as @ replace x ys bs)"
by(induct as) auto

lemma distinct_set_replace: "distinct xs 
 set (replace x ys xs) =
 (if x  set xs then (set xs - {x})  set ys else set xs)"
apply(induct xs)
 apply(simp)
apply simp
apply blast
done

lemma replace1:
 "f  set (replace f' fs ls )  f  set ls  f  set fs" 
proof (induct ls)
  case Nil then show ?case by simp
next
  case (Cons l ls) then show ?case by (simp split: if_split_asm)
qed

lemma replace2:
 "f'  set ls  replace f' fs ls  = ls" 
proof (induct ls)
  case Nil then show ?case by simp
next
  case (Cons l ls) then show ?case by (auto split: if_split_asm)
qed

lemma replace3[intro]:
  "f'  set ls  f  set fs  f  set (replace f' fs ls)"
by (induct ls) auto

lemma replace4:
  "f  set ls  oldF  f  f  set (replace oldF fs ls)" 
by (induct ls) auto

lemma replace5: "f  set (replace oldF newfs fs)  f  set fs  f  set newfs"
by (induct fs) (auto split: if_split_asm) 

lemma replace6: "distinct oldfs  x  set (replace oldF newfs oldfs) = 
  ((x  oldF  oldF  set newfs)  ((oldF  set oldfs  x  set newfs)  x  set oldfs))"
by (induct oldfs) auto


lemma distinct_replace: 
"distinct fs  distinct newFs  set fs  set newFs  {oldF} 
 distinct (replace oldF newFs fs)"
proof (induct fs)
  case Nil then show ?case by simp
next
  case (Cons f fs)
  then show ?case
  proof (cases "f = oldF") 
    case True with Cons show ?thesis by simp blast
  next
    case False 
    moreover with Cons have "f  set newFs" by simp blast
    with Cons have "f  set (replace oldF newFs fs)" 
     by simp (blast dest: replace1) 
    moreover from Cons have "distinct (replace oldF newFs fs)"
      by (rule_tac Cons) auto  
    ultimately show ?thesis by simp 
  qed
qed

lemma replace_replace[simp]: "oldf  set newfs  distinct xs  
  replace oldf newfs (replace oldf newfs xs) = replace oldf newfs xs"
apply (induct xs) apply auto apply (rule replace2) by simp 

lemma replace_distinct: "distinct fs  distinct newfs  oldf  set fs  set newfs  set fs  {oldf}  
  distinct (replace oldf newfs fs)"
apply (case_tac "oldf  set fs") apply simp
apply (induct fs) apply simp
apply (auto simp: replace2) apply (drule replace1)
by auto


lemma filter_replace2:
 " ¬ P x; y set ys. ¬ P y  
  filter P (replace x ys xs) = filter P xs"
apply(cases "x  set xs")
 prefer 2 apply(simp add:replace2)
apply(induct xs)
 apply simp
apply clarsimp
done

lemma length_filter_replace1:
 " x  set xs; ¬ P x  
  length(filter P (replace x ys xs)) =
  length(filter P xs) + length(filter P ys)"
apply(induct xs)
 apply simp
apply fastforce
done

lemma length_filter_replace2:
 " x  set xs; P x  
  length(filter P (replace x ys xs)) =
  length(filter P xs) + length(filter P ys) - 1"
apply(induct xs)
 apply simp
apply auto
apply(drule split_list)
apply clarsimp
done


subsubsection @{const"distinct"}

lemma dist_at1: " c vs. distinct vs  vs = a @ r # b  vs = c @ r # d  a = c"
proof (induct a)
  case Nil
  assume dist: "distinct vs" and vs1: "vs = [] @ r # b" and vs2: "vs = c @ r # d"
  from dist vs2 have rc: "r  set c" by auto
  from vs1 vs2 have "c @ r # d = r # b" by auto
  then have "hd (c @ r # d) = r" by auto
  then have "c  []  hd c = r" by auto
  then have "c  []  r  set c" by (induct c) auto
  with rc have c: "c = []" by auto
  then show ?case by auto
next
  case (Cons x xs) then show ?case by (induct c)  auto
qed

lemma dist_at: "distinct vs  vs = a @ r # b  vs = c @ r # d  a = c  b = d"
proof -
  assume dist: "distinct vs" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
  then have "a = c" by (rule_tac dist_at1) auto
  with dist vs1 vs2 show ?thesis by simp
qed

lemma dist_at2: "distinct vs  vs = a @ r # b  vs = c @ r # d  b = d"
proof -
  assume dist: "distinct vs" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
  then have "a = c  b = d" by (rule_tac dist_at) auto
  then show ?thesis by auto
qed

lemma distinct_split1: "distinct xs  xs = y @ [r] @ z   r  set y"
  apply auto done

lemma distinct_split2: "distinct xs  xs = y @ [r] @ z   r  set z" apply auto done

lemma distinct_hd_not_cons: "distinct vs   as bs. vs = as @ x # hd vs # bs  False"
proof -
  assume d: "distinct vs" and ex: " as bs. vs = as @ x # hd vs # bs"
  from ex have vsne: "vs  []" by auto
  with d ex show ?thesis apply (elim exE) apply (case_tac "as")
    apply (subgoal_tac "hd vs = x") apply simp apply (rule sym)  apply simp
    apply (subgoal_tac "x = hd (x # (hd vs # bs))") apply simp apply (thin_tac "vs = x # hd vs # bs")
    apply auto
    apply (subgoal_tac "hd vs = a") apply simp
    apply (subgoal_tac "a = hd (a # list @ x # hd vs # bs)") apply simp
    apply (thin_tac "vs = a # list @ x # hd vs # bs") by auto
qed

subsubsection ‹Misc›

(* FIXME move to List *)
lemma drop_last_in: "n. n < length ls  last ls  set (drop n ls)"
apply (frule_tac last_drop) apply(erule subst)
apply (case_tac "drop n ls" rule: rev_exhaust) by simp_all

lemma nth_last_Suc_n: "distinct ls  n < length ls  last ls = ls ! n  Suc n = length ls"
proof (rule ccontr)
  assume d: "distinct ls" and n: "n < length ls" and l: "last ls = ls ! n" and not: "Suc n  length ls"
  then have s: "Suc n < length ls" by auto
  define lls where  "lls = ls!n"
  with n have "take (Suc n) ls = take n ls @ [lls]" apply simp by (rule take_Suc_conv_app_nth)
  then have "take (Suc n) ls @ drop (Suc n) ls = take n ls @ [lls] @ drop (Suc n) ls" by auto
  then have ls: "ls = take n ls @ [lls] @ drop (Suc n) ls" by auto
  with d have dls: "distinct (take n ls @ [lls] @ drop (Suc n) ls)" by auto
  from lls_def l have "lls = (last ls)" by auto
  with s have "lls  set (drop (Suc n) ls)" apply simp by (rule_tac drop_last_in)
  with dls show False by auto
qed


(****************************** rotate *************************)

subsubsection @{const rotate}

lemma  plus_length1[simp]: "rotate (k+(length ls)) ls = rotate k ls "
proof -
  have " k ls. rotate k (rotate (length ls) ls) = rotate (k+(length ls)) ls"
    by (rule rotate_rotate)
  then have " k ls. rotate k ls =  rotate (k+(length ls)) ls" by auto
  then show ?thesis by (rule sym)
qed

lemma  plus_length2[simp]: "rotate ((length ls)+k) ls = rotate k ls "
proof -
  define x where "x = (length ls)+k"
  then have "x = k+(length ls)" by auto
  with x_def have "rotate x ls = rotate (k+(length ls)) ls" by simp
  then have "rotate x ls = rotate k ls" by simp
  with x_def show ?thesis by simp
qed

lemma rotate_minus1: "n > 0  m > 0 
 rotate n ls = rotate m ms  rotate (n - 1) ls = rotate (m - 1) ms"
proof (cases "ls = []")
  assume r: "rotate n ls = rotate m ms"
  case True with r
  have "rotate m ms = []" by auto
  then have "ms = []" by auto
  with True show ?thesis by auto
next
  assume n: "n > 0" and m: "m > 0" and r: "rotate n ls = rotate m ms"
  case False
  then have lls: "length ls > 0" by auto
  with r have lms: "length ms > 0" by auto
  have mem1: "rotate (n - 1) ls = rotate ((n - 1) + length ls) ls" by auto
  from n lls have "(n - 1) + length ls = (length ls - 1) + n" by arith
  then have "rotate ((n - 1) + length ls) ls = rotate ((length ls - 1) + n) ls" by auto
  with mem1 have mem2: "rotate (n - 1) ls = rotate ((length ls - 1) + n) ls" by auto
  have "rotate ((length ls - 1) + n) ls = rotate (length ls - 1) (rotate n ls)" apply (rule sym)
    by (rule rotate_rotate)
  with mem2 have mem3: "rotate (n - 1) ls = rotate (length ls - 1) (rotate n ls)" by auto
  from r have "rotate (length ls - 1) (rotate n ls) = rotate (length ls - 1) (rotate m ms)" by auto
  with mem3 have mem4: "rotate (n - 1) ls = rotate (length ls - 1) (rotate m ms)" by auto
  have "rotate (length ls - 1) (rotate m ms) = rotate (length ls - 1 + m) ms"  by (rule rotate_rotate)
  with mem4 have mem5: "rotate (n - 1) ls = rotate (length ls - 1 + m) ms" by auto
  from r have "length (rotate n ls) = length (rotate m ms)" by simp
  then have "length ls = length ms" by auto
  with m lms have "length ls - 1 + m = (m - 1) + length ms" by arith
  with mem5 have mem6: "rotate (n - 1) ls = rotate ((m - 1) + length ms) ms" by auto
  have "rotate ((m - 1) + length ms) ms = rotate (m - 1) (rotate (length ms) ms)" by auto
  then have "rotate ((m - 1) + length ms) ms = rotate (m - 1) ms" by auto
  with mem6 show ?thesis by auto
qed

lemma rotate_minus1': "n > 0  rotate n ls = ms 
  rotate (n - 1) ls = rotate (length ms - 1) ms"
proof (cases "ls = []")
  assume r: "rotate n ls = ms"
  case True with r show ?thesis by auto
next
  assume n: "n > 0" and r:"rotate n ls = ms"
  then have r': "rotate n ls = rotate (length ms) ms" by auto
  case False
  with n r' show ?thesis apply (rule_tac rotate_minus1) by auto
qed

lemma rotate_inv1: " ms. n < length ls  rotate n ls = ms 
  ls = rotate ((length ls) - n) ms"
proof (induct n)
  case 0 then show ?case by auto
next
  case (Suc n) then show ?case
  proof (cases "ls = []")
    case True with Suc
    show ?thesis by auto
  next
    case False
    then have ll: "length ls > 0" by auto
    from Suc have nl: "n < length ls" by auto
    from Suc have r: "rotate (Suc n) ls = ms" by auto
    then have "rotate (Suc n - 1) ls = rotate (length ms - 1) ms" apply (rule_tac rotate_minus1') by auto
    then have "rotate n ls = rotate (length ms - 1) ms" by auto
    then have mem: "ls = rotate (length ls - n) (rotate (length ms - 1) ms)"
      apply (rule_tac Suc) by (auto simp: nl)
    have " rotate (length ls - n) (rotate (length ms - 1) ms) = rotate (length ls - n + (length ms - 1)) ms"
      by (rule rotate_rotate)
    with mem have mem2: "ls =  rotate (length ls - n + (length ms - 1)) ms" by auto
    from r have leq: "length ms = length ls" by auto
    with False nl have "length ls - n + (length ms - 1) = length ms + (length ms - (Suc n))"
      by arith
    then have "rotate (length ls - n + (length ms - 1)) ms = rotate (length ms + (length ms - (Suc n))) ms"
      by auto
    with mem2 have mem3: "ls = rotate (length ms + (length ms - (Suc n))) ms" by auto
    have "rotate (length ms + (length ms - (Suc n))) ms = rotate (length ms - (Suc n)) ms" by simp
    with mem3 leq show ?thesis by auto
  qed
qed

lemma rotate_conv_mod'[simp]: "rotate (n mod length ls) ls = rotate n ls"
by(simp add:rotate_drop_take)

lemma rotate_inv2: "rotate n ls = ms 
 ls = rotate ((length ls) - (n mod length ls)) ms"
proof (cases "ls  = []")
  assume r: "rotate n ls = ms"
  case True with r show ?thesis by auto
next
  assume r: "rotate n ls = ms"
  then have r': "rotate (n mod length ls) ls = ms" by auto
  case False
  then have "length ls > 0" by auto
  with r' show ?thesis apply (rule_tac rotate_inv1) by auto
qed

lemma rotate_id[simp]: "rotate ((length ls) - (n mod length ls)) (rotate n ls) = ls"
apply (rule sym) apply (rule rotate_inv2) by simp

lemma nth_rotate1_Suc: "Suc n < length ls  ls!(Suc n) = (rotate1 ls)!n"
  apply (cases ls) apply auto
  by (simp add: nth_append)

lemma nth_rotate1_0: "ls!0 = (rotate1 ls)!(length ls - 1)" apply (cases ls)  by auto

lemma nth_rotate1: "0 < length ls  ls!((Suc n) mod (length ls)) = (rotate1 ls)!(n mod (length ls))"
proof (cases "0 < (Suc n) mod (length ls)")
  assume lls: "0 < length ls"
  case True
  define m where "m = (Suc n) mod (length ls) - 1"
  with True have m: "Suc m = (Suc n) mod (length ls)" by auto
  with lls have a: "(Suc m) <   length ls" by auto
  from lls m have "m = n mod (length ls)" by (simp add: mod_Suc split:if_split_asm)
  with a m show ?thesis apply (drule_tac nth_rotate1_Suc) by auto
next
  assume lls: "0 < length ls"
  case False
  then have a: "(Suc n) mod (length ls) = 0" by auto
  with lls have "Suc (n mod (length ls)) = (length ls)" by (auto simp: mod_Suc split: if_split_asm)
  then have "(n mod (length ls)) = (length ls) - 1" by arith
  with a show ?thesis by (auto simp: nth_rotate1_0)
qed

lemma rotate_Suc2[simp]: "rotate n (rotate1 xs) = rotate (Suc n) xs"
apply (simp add:rotate_def) apply (induct n) by auto

lemma nth_rotate: " ls. 0 < length ls  ls!((n+m) mod (length ls)) = (rotate m ls)!(n mod (length ls))"
proof (induct m)
  case 0 then show ?case by auto
next
  case (Suc m)
  define z where "z = n + m"
  then have "n + Suc m = Suc (z)" by auto
  with Suc have r1: "ls ! ((Suc z) mod length ls) = rotate1 ls ! (z mod length ls)"
    by (rule_tac nth_rotate1)
  from Suc have "0 < length (rotate1 ls)" by auto
  then have "(rotate1 ls) ! ((n + m) mod length (rotate1 ls))
    = rotate m (rotate1 ls) ! (n mod length (rotate1 ls))" by (rule Suc)
  with r1 z_def have "ls ! ((n + Suc m) mod length ls)
    = rotate m (rotate1 ls) ! (n mod length (rotate1 ls))" by auto
  then show ?case by auto
qed


(************************* SplitAt *******************************************)

subsection splitAt›

primrec splitAtRec :: "'a  'a list  'a list  'a list × 'a list" where
  "splitAtRec c bs [] = (bs,[])"
| "splitAtRec c bs (a#as) = (if a = c then (bs, as)
                              else splitAtRec c (bs@[a]) as)"

definition splitAt :: "'a  'a list  'a list × 'a list" where
  "splitAt c as   splitAtRec c [] as"


subsubsection @{const splitAtRec}

lemma splitAtRec_conv: "bs.
 splitAtRec x bs xs =
 (bs @ takeWhile (λy. yx) xs, tl(dropWhile (λy. yx) xs))"
by(induct xs) auto

lemma splitAtRec_distinct_fst: " s. distinct vs  distinct s  (set s)   (set vs) = {}  distinct (fst (splitAtRec ram1 s vs))"
by (induct vs) auto

lemma splitAtRec_distinct_snd: " s. distinct vs  distinct s  (set s)   (set vs) = {}  distinct (snd (splitAtRec ram1 s vs))"
by (induct vs) auto

lemma splitAtRec_ram:
  " us a b. ram  set vs  (a, b) = splitAtRec ram us vs 
  us @ vs = a @ [ram] @ b"
proof (induct vs)
case  Nil then show ?case by simp
next
case (Cons v vs) then show ?case by (auto dest: Cons(1) split: if_split_asm)
qed

lemma splitAtRec_notRam:
 " us. ram   set vs  splitAtRec ram us vs = (us @ vs, [])"
proof (induct vs)
case  Nil then show ?case by simp
next
case (Cons v vs) then show ?case by auto
qed

lemma splitAtRec_distinct: " s. distinct vs 
  distinct s  (set s)  (set vs) = {} 
  set (fst (splitAtRec ram s vs))  set (snd (splitAtRec ram s vs)) = {}"
by (induct vs) auto



subsubsection @{const splitAt}

lemma splitAt_conv:
 "splitAt x xs = (takeWhile (λy. yx) xs, tl(dropWhile (λy. yx) xs))"
by(simp add: splitAt_def splitAtRec_conv)

lemma splitAt_no_ram[simp]:
  "ram  set vs  splitAt ram vs = (vs, [])"
  by (auto simp: splitAt_def splitAtRec_notRam)

lemma splitAt_split:
  "ram  set vs  (a,b) = splitAt ram vs  vs = a @ ram # b"
  by (auto simp: splitAt_def dest: splitAtRec_ram)

lemma splitAt_ram:
  "ram  set vs  vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs)"
 by (rule_tac splitAt_split) auto

lemma fst_splitAt_last:
 " xs  []; distinct xs   fst (splitAt (last xs) xs) = butlast xs"
by(simp add:splitAt_conv takeWhile_not_last)


subsubsection ‹Sets›

lemma splitAtRec_union:
" a b s. (a,b) = splitAtRec ram s vs  (set a  set b) - {ram} = (set vs  set s) - {ram}"
  apply (induct vs) by (auto split: if_split_asm)

lemma splitAt_subset_ab:
  "(a,b) = splitAt ram vs  set a  set vs  set b  set vs"
  apply (cases "ram  set vs")
  by (auto dest: splitAt_split simp: splitAt_no_ram)

lemma splitAt_in_fst[dest]: "v  set (fst (splitAt ram vs))  v  set vs"
proof (cases "ram  set vs")
  assume v: "v  set (fst (splitAt ram vs))"
  define a where "a = fst (splitAt ram vs)"
  with v have vin: "v  set a" by auto
  define b where "b = snd (splitAt ram vs)"
  case True with a_def b_def  have "vs = a @ ram # b" by (auto dest: splitAt_ram)
  with vin show "v  set vs" by auto
next
  assume v: "v  set (fst (splitAt ram vs))"
  case False with v show ?thesis by (auto dest: splitAt_no_ram del: notI)
qed

lemma splitAt_not1:
"v  set vs  v  set (fst (splitAt ram vs))" by (auto dest: splitAt_in_fst)

lemma splitAt_in_snd[dest]: "v  set (snd (splitAt ram vs))  v  set vs"
proof (cases "ram  set vs")
  assume v: "v  set (snd (splitAt ram vs))"
  define a where "a = fst (splitAt ram vs)"
  define b where "b = snd (splitAt ram vs)"
  with v have vin: "v  set b" by auto
  case True with a_def b_def  have "vs = a @ ram # b" by (auto dest: splitAt_ram)
  with vin show "v  set vs" by auto
next
  assume v: "v  set (snd (splitAt ram vs))"
  case False with v show ?thesis by (auto dest: splitAt_no_ram del: notI)
qed


subsubsection ‹Distinctness›

lemma splitAt_distinct_ab_aux:
 "distinct vs  (a,b) = splitAt ram vs  distinct a  distinct b"
  by (cases "ram  set vs") (auto dest: splitAt_split simp: splitAt_no_ram)

lemma splitAt_distinct_fst_aux[intro]:
 "distinct vs  distinct (fst (splitAt ram vs))"
proof -
  assume d: "distinct vs"
  define b where "b = snd (splitAt ram vs)"
  define a where "a = fst (splitAt ram vs)"
  with b_def have "(a,b) = splitAt ram vs" by auto
  with a_def d show ?thesis  by (auto dest: splitAt_distinct_ab_aux)
qed

lemma splitAt_distinct_snd_aux[intro]:
 "distinct vs  distinct (snd (splitAt ram vs))"
proof -
  assume d: "distinct vs"
  define b where "b = snd (splitAt ram vs)"
  define a where "a = fst (splitAt ram vs)"
  with b_def have "(a,b) = splitAt ram vs" by auto
  with b_def d show ?thesis  by (auto dest: splitAt_distinct_ab_aux)
qed

lemma splitAt_distinct_ab:
  "distinct vs   (a,b) = splitAt ram vs  set a  set b = {}"
  apply (cases "ram  set vs") apply (drule_tac splitAt_split)
  by (auto simp: splitAt_no_ram)

lemma splitAt_distinct_fst_snd:
    "distinct vs   set (fst (splitAt ram vs))  set (snd (splitAt ram vs)) = {}"
  by (rule_tac splitAt_distinct_ab) simp_all

lemma splitAt_distinct_ram_fst[intro]:
  "distinct vs  ram  set (fst (splitAt ram vs))"
  apply (case_tac "ram  set vs") apply (drule_tac splitAt_ram)
  apply (rule distinct_split1) by (force dest: splitAt_in_fst)+
(*  apply (frule splitAt_no_ram) by auto  *)

lemma splitAt_distinct_ram_snd[intro]:
  "distinct vs  ram  set (snd (splitAt ram vs))"
  apply (case_tac "ram  set vs") apply (drule_tac splitAt_ram)
  apply (rule distinct_split2) by (force dest: splitAt_in_fst)+

lemma splitAt_1[simp]:
  "splitAt ram [] = ([],[])" by (simp add: splitAt_def)

lemma splitAt_2:
  "v  set vs  (a,b) = splitAt ram vs  v  set a  v  set b  v = ram "
apply (cases "ram  set vs")
 by (auto dest: splitAt_split simp: splitAt_no_ram)

lemma splitAt_distinct_fst: "distinct vs  distinct (fst (splitAt ram1 vs))"
by (simp add: splitAt_def splitAtRec_distinct_fst)

lemma splitAt_distinct_a: "distinct vs  (a,b) = splitAt ram vs  distinct a"
by (auto dest: splitAt_distinct_fst pairD)

lemma splitAt_distinct_snd: "distinct vs  distinct (snd (splitAt ram1 vs))"
by (simp add: splitAt_def splitAtRec_distinct_snd)

lemma splitAt_distinct_b: "distinct vs  (a,b) = splitAt ram vs  distinct b"
by (auto dest: splitAt_distinct_snd pairD)

lemma splitAt_distinct: "distinct vs  set (fst (splitAt ram vs))  set (snd (splitAt ram vs)) = {}"
by (simp add: splitAt_def splitAtRec_distinct)

lemma splitAt_subset: "(a,b) = splitAt ram vs  (set a  set vs)  (set b  set vs)"
apply (cases "ram  set vs") by (auto dest: splitAt_split simp: splitAt_no_ram)


subsubsection @{const splitAt} composition›

lemma set_help: "v  set ( as @ bs)  v  set as  v  set bs" by auto

lemma splitAt_elements: "ram1  set vs  ram2  set vs  ram2  set( fst (splitAt ram1 vs))  ram2  set [ram1]   ram2  set( snd (splitAt ram1 vs))"
proof -
  assume r1: "ram1  set vs" and r2: "ram2  set vs"
  then have "ram2  set( fst (splitAt ram1 vs) @ [ram1])   ram2  set( snd (splitAt ram1 vs))"
  apply (rule_tac set_help)
  apply (drule_tac splitAt_ram) by auto
  then show ?thesis by auto
qed

lemma splitAt_ram3: "ram2   set (fst (splitAt ram1 vs)) 
  ram1  set vs  ram2  set vs  ram1  ram2 
  ram2  set (snd (splitAt ram1 vs))" by (auto dest: splitAt_elements)

lemma splitAt_dist_ram: "distinct vs 
 vs = a @ ram # b  (a,b) = splitAt ram vs"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram # b"
  from vs have r:"ram  set vs" by auto
  with dist vs have "fst (splitAt ram vs) = a" apply (drule_tac splitAt_ram) by (rule_tac dist_at1)  auto
  then have first:"a = fst (splitAt ram vs)" by   auto
  from r dist have second: "b = snd (splitAt ram vs)" apply (drule_tac splitAt_ram) apply (rule dist_at2) apply simp
    by (auto simp: vs)
  show ?thesis by (auto simp: first second)
qed

lemma distinct_unique1: "distinct vs  ram  set vs  ∃!s. vs = (fst s) @ ram # (snd s)"
proof
  assume d: "distinct vs" and r: "ram  set vs"
  define s where "s = splitAt ram vs"
  with r show  "vs = (fst s) @ ram # (snd s)"
    by (auto intro: splitAt_ram)
next
  fix s
  assume d: "distinct vs" and vs1: "vs = fst s @ ram # snd s"
  from d vs1 show "s = splitAt ram vs" apply (drule_tac splitAt_dist_ram) apply simp by simp
qed

lemma splitAt_dist_ram2: "distinct vs  vs = a @ ram1 # b @ ram2 # c 
 (a @ ram1 # b, c) = splitAt ram2 vs"
by (auto intro: splitAt_dist_ram)

lemma splitAt_dist_ram20: "distinct vs  vs = a @ ram1 # b @ ram2 # c 
  c = snd (splitAt ram2 vs)"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then show "c = snd (splitAt ram2 vs)" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
qed

lemma splitAt_dist_ram21: "distinct vs  vs = a @ ram1 # b @ ram2 # c  (a, b) = splitAt ram1 (fst (splitAt ram2 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "fst (splitAt ram2 vs) = a @ ram1 # b" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
  with dist vs show ?thesis by (rule_tac splitAt_dist_ram) auto
qed

lemma splitAt_dist_ram22: "distinct vs  vs = a @ ram1 # b @ ram2 # c   (c, []) = splitAt ram1 (snd (splitAt ram2 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "snd (splitAt ram2 vs) = c" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
  with dist vs have "splitAt ram1 (snd (splitAt ram2 vs)) = (c, [])" by (auto intro: splitAt_no_ram)
  then show ?thesis by auto
qed

lemma splitAt_dist_ram1: "distinct vs  vs = a @ ram1 # b @ ram2 # c  (a, b @ ram2 # c) = splitAt ram1 vs"
by (auto intro: splitAt_dist_ram)

lemma splitAt_dist_ram10: "distinct vs  vs = a @ ram1 # b @ ram2 # c  a = fst (splitAt ram1 vs)"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then show "a = fst (splitAt ram1 vs)" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
qed

lemma splitAt_dist_ram11: "distinct vs  vs = a @ ram1 # b @ ram2 # c  (a, []) = splitAt ram2 (fst (splitAt ram1 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "fst (splitAt ram1 vs) = a" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
  with dist vs have "splitAt ram2 (fst (splitAt ram1 vs)) = (a, [])" by (auto intro: splitAt_no_ram)
  then show ?thesis by auto
qed

lemma splitAt_dist_ram12: "distinct vs  vs = a @ ram1 # b @ ram2 # c   (b, c) = splitAt ram2 (snd (splitAt ram1 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "snd (splitAt ram1 vs) = b @ ram2 # c" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
  with dist vs show ?thesis by (rule_tac splitAt_dist_ram)  auto
qed

lemma splitAt_dist_ram_all:
  "distinct vs  vs = a @ ram1 # b @ ram2 # c
   (a, b) = splitAt ram1 (fst (splitAt ram2 vs))
   (c, []) = splitAt ram1 (snd (splitAt ram2 vs))
   (a, []) = splitAt ram2 (fst (splitAt ram1 vs))
   (b, c) = splitAt ram2 (snd (splitAt ram1 vs))
    c = snd (splitAt ram2 vs)
    a = fst (splitAt ram1 vs)"
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram21) apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram22) apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram11 splitAt_dist_ram22) apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram12)apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram20) apply simp apply simp
                            by (rule_tac splitAt_dist_ram10) auto


subsubsection ‹Mixed›

lemma fst_splitAt_rev:
 "distinct xs  x  set xs 
  fst(splitAt x (rev xs)) = rev(snd(splitAt x xs))"
by(simp add:splitAt_conv takeWhile_neq_rev)

lemma snd_splitAt_rev:
 "distinct xs  x  set xs 
  snd(splitAt x (rev xs)) = rev(fst(splitAt x xs))"
by(simp add:splitAt_conv dropWhile_neq_rev)

lemma splitAt_take[simp]: "distinct ls  i < length ls  fst (splitAt (ls!i) ls) = take i ls"
proof -
  assume d: "distinct ls" and si: "i < length ls"
  then have ls1: "ls = take i ls @ ls!i # drop (Suc i) ls" by (rule_tac id_take_nth_drop)
  from si have "ls!i  set ls" by auto
  then have ls2: "ls = fst (splitAt (ls!i) ls) @ ls!i # snd (splitAt (ls!i) ls)" by (auto dest: splitAt_ram)
  from d ls2 ls1 have "fst (splitAt (ls!i) ls) = take i ls  snd (splitAt (ls!i) ls) = drop (Suc i) ls" by (rule dist_at)
   then show ?thesis by auto
qed

lemma splitAt_drop[simp]: "distinct ls   i < length ls  snd (splitAt (ls!i) ls) = drop (Suc i) ls"
proof -
  assume d: "distinct ls" and si: "i < length ls"
  then have ls1: "ls = take i ls @ ls!i # drop (Suc i) ls" by (rule_tac id_take_nth_drop)
  from si have "ls!i  set ls" by auto
  then have ls2: "ls = fst (splitAt (ls!i) ls) @ ls!i # snd (splitAt (ls!i) ls)" by (auto dest: splitAt_ram)
  from d ls2 ls1 have "fst (splitAt (ls!i) ls) = take i ls  snd (splitAt (ls!i) ls) = drop (Suc i) ls" by (rule dist_at)
   then show ?thesis by auto
qed

lemma fst_splitAt_upt:
 "j  i  i < k  fst(splitAt i [j..<k]) = [j..<i]"
using splitAt_take[where ls = "[j..<k]" and i="i-j"]
apply (simp del:splitAt_take)
done

lemma snd_splitAt_upt:
 "j  i  i < k  snd(splitAt i [j..<k]) = [i+1..<k]"
using splitAt_drop[where ls = "[j..<k]" and i="i-j"]
by simp

lemma local_help1: " a vs. vs = c @ r # d  vs = a @ r # b  r  set a  r  set b  a = c"
proof (induct c)
  case Nil
  then have ra: "r  set a" and vs1: "vs = a @ r # b" and vs2: "vs = [] @ r # d"
    by auto
  from vs1 vs2 have "a @ r # b = r # d" by auto
  then have "hd (a @ r # b) = r" by auto
  then have "a  []  hd a = r" by auto
  then have "a  []  r  set a" by (induct a) auto
  with ra have a: "a = []" by auto
  then show ?case by auto
next
  case (Cons x xs) then show ?case by (induct a) auto
qed

lemma local_help: "vs = a @ r # b  vs = c @ r # d  r  set a  r  set b  a = c  b = d"
proof -
  assume dist: "r  set a" "r  set b" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
  from vs2 vs1 dist have "a = c" by (rule local_help1)
  with dist vs1 vs2 show ?thesis by simp
qed

lemma local_help': "a @ r # b = c @ r # d  r  set a  r  set b  a = c  b = d"
by (rule local_help) auto


lemma splitAt_simp1: "ram  set a  ram  set b  fst (splitAt ram (a @ ram # b)) = a "
proof -
  assume ramab: "ram  set a"  "ram  set b"
  define vs where "vs = a @ ram # b"
  then have vs: "vs = a @ ram # b" by auto
  then have "ram  set vs" by auto
  then have "vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs)" by (auto dest: splitAt_ram)
  with  vs ramab show ?thesis apply simp apply (rule_tac sym)  apply (rule_tac local_help1) apply simp
    apply (rule sym) apply assumption by auto
qed


lemma help'''_in: " xs. ram  set b  fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
proof (induct b)
case Nil then show ?case by auto
next
case (Cons b bs) show ?case using Cons(2)
  apply (case_tac "b = ram") apply simp
  apply simp
  apply (subgoal_tac "fst (splitAtRec ram (xs @ [b]) bs) = (xs@[b]) @ fst (splitAtRec ram [] bs)") apply simp
  apply (subgoal_tac "fst (splitAtRec ram [b] bs) = [b] @ fst (splitAtRec ram [] bs)") apply simp
  apply (rule Cons) apply force
  apply (rule Cons) by force
qed

lemma help'''_notin: " xs. ram   set b  fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
proof (induct b)
case Nil then show ?case by auto
next
case (Cons b bs)
then have "ram  set bs" by auto
then show ?case
  apply (case_tac "b = ram") apply simp
  apply simp
  apply (subgoal_tac "fst (splitAtRec ram (xs @ [b]) bs) = (xs@[b]) @ fst (splitAtRec ram [] bs)") apply simp
  apply (subgoal_tac "fst (splitAtRec ram [b] bs) = [b] @ fst (splitAtRec ram [] bs)") apply simp
  apply (rule Cons) apply simp
  apply (rule Cons) by simp
qed

lemma help''': "fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
apply (cases "ram  set b")
apply (rule_tac help'''_in) apply simp
apply (rule_tac help'''_notin) apply simp done

lemma splitAt_simpA[simp]: "fst (splitAt ram (ram # b)) = []" by (simp add: splitAt_def)
lemma splitAt_simpB[simp]: "ram  a  fst (splitAt ram (a # b)) = a # fst (splitAt ram b)" apply (simp add: splitAt_def)
  apply (subgoal_tac "fst (splitAtRec ram [a] b) = [a] @ fst (splitAtRec ram [] b)") apply simp by (rule help''')
lemma splitAt_simpB'[simp]: "a  ram  fst (splitAt ram (a # b)) = a # fst (splitAt ram b)" apply (rule splitAt_simpB) by auto
lemma splitAt_simpC[simp]: "ram  set a   fst (splitAt ram (a @ b)) = a @ fst (splitAt ram b)"
apply (induct a) by auto

lemma help'''': " xs ys. snd (splitAtRec ram xs b) = snd (splitAtRec ram ys b)"
apply (induct b) by auto

lemma splitAt_simpD[simp]: " a. ram  a  snd (splitAt ram (a # b)) = snd (splitAt ram b)" apply (simp add: splitAt_def)
by (rule help'''')
lemma splitAt_simpD'[simp]: " a. a  ram  snd (splitAt ram (a # b)) = snd (splitAt ram b)" apply (rule splitAt_simpD) by auto

lemma splitAt_simpE[simp]: "snd (splitAt ram (ram # b)) = b" by (simp add: splitAt_def)

lemma splitAt_simpF[simp]: "ram  set a   snd (splitAt ram (a @ b)) = snd (splitAt ram b) "
apply (induct a) by auto


lemma splitAt_rotate_pair_conv:
  "xs.  distinct xs; x  set xs 
   snd (splitAt x (rotate n xs)) @ fst (splitAt x (rotate n xs)) =
      snd (splitAt x xs) @ fst (splitAt x xs)"
apply(induct n) apply simp
apply(simp del:rotate_Suc2 add:rotate1_rotate_swap)
apply(case_tac xs) apply clarsimp+
apply(erule disjE) apply simp
apply(drule split_list)
apply clarsimp
done


subsection between›

definition between :: "'a list  'a  'a  'a list" where
 "between vs ram1 ram2 
     let (pre1, post1) = splitAt ram1 vs in
     if ram2  set post1
     then let (pre2, post2) = splitAt ram2 post1 in pre2
     else let (pre2, post2) = splitAt ram2 pre1 in post1 @ pre2"

lemma inbetween_inset:
 "x  set(between xs a b)  x  set xs"
apply(simp add:between_def split_def split:if_split_asm)
 apply(blast dest:splitAt_in_snd)
apply(blast dest:splitAt_in_snd)
done

lemma notinset_notinbetween:
 "x  set xs  x  set(between xs a b)"
by(blast dest:inbetween_inset)


lemma set_between_id:
 "distinct xs  x  set xs 
  set(between xs x x) = set xs - {x}"
apply(drule split_list)
apply (clarsimp simp:between_def split_def Un_commute)
done


lemma split_between:
 " distinct vs; r  set vs; v  set vs; u  set(between vs r v)  
  between vs r v =
 (if r=u then [] else between vs r u @ [u]) @ between vs u v"
apply(cases  "r = v")
 apply(clarsimp)
 apply(frule split_list[of v])
 apply(clarsimp)
 apply(simp add:between_def split_def split:if_split_asm)
 apply(erule disjE)
  apply(frule split_list[of u])
  apply(clarsimp)
  apply(frule split_list[of u])
  apply(clarsimp)
 apply(clarsimp)
 apply(frule split_list[of r])
apply(clarsimp)
apply(rename_tac as bs)
apply(erule disjE)
 apply(frule split_list[of v])
 apply(clarsimp)
 apply(rename_tac cs ds)
 apply(subgoal_tac "between (cs @ v # ds @ r # bs) r v = bs @ cs")
  prefer 2 apply(simp add:between_def split_def split:if_split_asm)
 apply simp
 apply(erule disjE)
  apply(frule split_list[of u])
  apply(clarsimp simp:between_def split_def split:if_split_asm)
 apply(frule split_list[of u])
 apply(clarsimp simp:between_def split_def split:if_split_asm)
apply(frule split_list[of v])
apply(clarsimp)
apply(rename_tac cs ds)
apply(subgoal_tac "between (as @ r # cs @ v # ds) r v = cs")
 prefer 2 apply(simp add:between_def split_def split:if_split_asm)
apply simp
apply(frule split_list[of u])
apply(clarsimp simp:between_def split_def split:if_split_asm)
done


subsection ‹Tables›

type_synonym ('a, 'b) table = "('a × 'b) list"

definition isTable :: "('a  'b)  'a list  ('a, 'b) table  bool" where
  "isTable f vs t  p. p  set t  snd p = f (fst p)  fst p  set vs" 

lemma isTable_eq: "isTable E vs ((a,b)#ps)  b = E a"
  by (auto simp add: isTable_def)

lemma isTable_subset: 
  "set qs  set ps  isTable E vs ps  isTable E vs qs"
  by (unfold isTable_def) auto

lemma isTable_Cons: "isTable E vs ((a,b)#ps)  isTable E vs ps"
  by (unfold isTable_def) auto


definition removeKey :: "'a  ('a × 'b) list  ('a × 'b) list" where
"removeKey a ps  [p  ps. a  fst p]"

primrec removeKeyList :: "'a list  ('a × 'b) list  ('a × 'b) list" where
  "removeKeyList [] ps = ps"
| "removeKeyList (w#ws) ps = removeKey w (removeKeyList ws ps)"

lemma removeKey_subset[simp]: "set (removeKey a ps)  set ps"
  by (simp add: removeKey_def) 

lemma length_removeKey[simp]: "|removeKey w ps|  |ps|"
  by (simp add: removeKey_def) 

lemma length_removeKeyList: 
  "length (removeKeyList ws ps)  length ps" (is "?P ws")
proof (induct ws)
    show "?P []" by simp
    fix w ws
    have "length (removeKey w (removeKeyList ws ps)) 
       length (removeKeyList ws ps)" 
      by (rule length_removeKey)
    also assume "?P ws" 
    finally show "?P (w#ws)" by simp
qed

lemma removeKeyList_subset[simp]: "set (removeKeyList ws ps)  set ps"
proof (induct ws) 
  case Nil then show ?case by simp
next
  case (Cons w ws) then show ?case
    by (metis dual_order.trans removeKeyList.simps(2) removeKey_subset)
qed

lemma notin_removeKey1: "(a, b)  set (removeKey a ps)"
  by (induct ps) (auto simp add: removeKey_def)

lemma removeKeyList_eq:
  "removeKeyList as ps = [p  ps. a  set as. a  fst p]"
by (induct as) (simp_all add: filter_comm removeKey_def)

lemma removeKey_empty[simp]: "removeKey a [] = []"
  by (simp add: removeKey_def)
lemma removeKeyList_empty[simp]: "removeKeyList ps [] = []"
  by (induct ps) simp_all
lemma removeKeyList_cons[simp]: 
  "removeKeyList ws (p#ps) 
  = (if fst p  set ws then removeKeyList ws ps else p#(removeKeyList ws ps))"
  by (induct ws) (simp_all split: if_split_asm add: removeKey_def)

end

Theory Quasi_Order

theory Quasi_Order
imports Main
begin

locale quasi_order =
fixes qle :: "'a  'a  bool" (infix "" 60)
assumes qle_refl[iff]: "x  x"
and qle_trans: "x  y  y  z  x  z"
begin

definition in_qle :: "'a  'a set  bool"  (infix "" 60) where
 "x  M  y  M. x  y"

definition subseteq_qle :: "'a set  'a set  bool" (infix "" 60) where
 "M  N  x  M. x  N"

definition seteq_qle :: "'a set  'a set  bool" (infix "=" 60) where
 "M = N    M  N  N  M"

lemmas "defs" = in_qle_def subseteq_qle_def seteq_qle_def

lemma subseteq_qle_refl[simp]: "M  M"
by(auto simp add: subseteq_qle_def in_qle_def)

lemma subseteq_qle_trans: "A  B  B  C  A  C"
by (simp add: subseteq_qle_def in_qle_def) (metis qle_trans)

lemma empty_subseteq_qle[simp]: "{}  A"
by (simp add: subseteq_qle_def)

lemma subseteq_qleI2: "(x. x  M  y  N. x  y)  M  N"
by (auto simp add: subseteq_qle_def in_qle_def)

lemma subseteq_qleD2: "M  N  x  M  y  N. x  y"
by (auto simp add: subseteq_qle_def in_qle_def)

lemma seteq_qle_refl[iff]: "A = A"
by (simp add: seteq_qle_def)

lemma seteq_qle_trans: "A = B  B = C  A = C"
by (simp add: seteq_qle_def) (metis subseteq_qle_trans)

end

end

Theory PlaneGraphIso

(*  Author: Tobias Nipkow  *)

section‹Isomorphisms Between Plane Graphs›

theory PlaneGraphIso
imports Main Quasi_Order
begin

(* FIXME globalize *)
lemma image_image_id_if[simp]: "(x. f(f x) = x)  f ` f ` M = M"
by (auto simp: image_iff)


declare not_None_eq [iff] not_Some_eq [iff]


text‹The symbols ≅› and ≃› are overloaded.  They
denote congruence and isomorphism on arbitrary types. On lists
(representing faces of graphs), ≅› means congruence modulo
rotation; ≃› is currently unused. On graphs, ≃›
means isomorphism and is a weaker version of ≅› (proper
isomorphism): ≃› also allows to reverse the orientation of
all faces.›

consts
 pr_isomorphic  :: "'a  'a  bool" (infix "" 60)
(* isomorphic :: "'a ⇒ 'a ⇒ bool" (infix "≃" 60)
*)
(*
definition "congs"  :: "'a list ⇒ 'a list ⇒ bool" (infix "≅" 60) where
 "F1 ≅ (F2::'a list) ≡ ∃n. F2 = rotate n F1"
*)
definition Iso :: "('a list * 'a list) set" ("{≅}") where
 "{≅}  {(F1, F2). F1  F2}"

lemma [iff]: "((x,y)  {≅}) = x  y"
by(simp add:Iso_def)

text‹A plane graph is a set or list (for executability) of faces
(hence Fgraph› and fgraph›) and a face is a list of
nodes:›

type_synonym 'a Fgraph = "'a list set"
type_synonym 'a fgraph = "'a list list"

subsection‹Equivalence of faces›

text‹Two faces are equivalent modulo rotation:›

overloading "congs"  "pr_isomorphic :: 'a list  'a list  bool"
begin
  definition "F1  (F2::'a list)  n. F2 = rotate n F1"
end

lemma congs_refl[iff]: "(xs::'a list)  xs"
apply(simp add:congs_def)
apply(rule_tac x = 0 in exI)
apply (simp)
done

lemma congs_sym: assumes A: "(xs::'a list)  ys" shows "ys  xs"
proof (simp add:congs_def)
  let ?l = "length xs"
  from A obtain n where ys: "ys = rotate n xs" by(fastforce simp add:congs_def)
  have "xs = rotate ?l xs" by simp
  also have " = rotate (?l - n mod ?l + n mod ?l) xs"
  proof (cases)
    assume "xs = []" thus ?thesis by simp
  next
    assume "xs  []"
    hence "n mod ?l < ?l" by simp
    hence "?l = ?l - n mod ?l + n mod ?l" by arith
    thus ?thesis by simp
  qed
  also have " = rotate (?l - n mod ?l) (rotate (n mod ?l) xs)"
    by(simp add:rotate_rotate)
  also have "rotate (n mod ?l) xs = rotate n xs"
    by(rule rotate_conv_mod[symmetric])
  finally show "m. xs = rotate m ys" by(fastforce simp add:ys)
qed

lemma congs_trans: "(xs::'a list)  ys  ys  zs  xs  zs"
apply(clarsimp simp:congs_def rotate_def)
apply(rename_tac m n)
apply(rule_tac x = "n+m" in exI)
apply (simp add:funpow_add)
done

lemma equiv_EqF: "equiv (UNIV::'a list set) {≅}"
apply(unfold equiv_def sym_def trans_def refl_on_def)
apply(rule conjI)
 apply simp
apply(rule conjI)
 apply(fastforce intro:congs_sym)
apply(fastforce intro:congs_trans)
done

lemma congs_distinct:
  "F1  F2  distinct F2 = distinct F1"
by (auto simp: congs_def)

lemma congs_length:
  "F1  F2  length F2 = length F1"
by (auto simp: congs_def)

lemma congs_pres_nodes: "F1  F2  set F1 = set F2"
by(clarsimp simp:congs_def)

lemma congs_map:
  "F1  F2  map f F1  map f F2"
by (auto simp: congs_def rotate_map)

lemma congs_map_eq_iff:
 "inj_on f (set xs  set ys)  (map f xs  map f ys) = (xs  ys)"
apply(simp add:congs_def)
apply(rule iffI)
 apply(clarsimp simp: rotate_map)
 apply(drule map_inj_on)
  apply(simp add:Un_commute)
 apply (fastforce)
apply clarsimp
apply(fastforce simp: rotate_map)
done


lemma list_cong_rev_iff[simp]:
  "(rev xs  rev ys) = (xs  ys)"
apply(simp add:congs_def rotate_rev)
apply(rule iffI)
 apply fast
apply clarify
apply(cases "length xs = 0")
 apply simp
apply(case_tac "n mod length xs = 0")
 apply(rule_tac x = "n" in exI)
 apply simp
apply(subst rotate_conv_mod)
apply(rule_tac x = "length xs - n mod length xs" in exI)
apply simp
done


lemma singleton_list_cong_eq_iff[simp]:
  "({xs::'a list} // {≅} = {ys} // {≅}) = (xs  ys)"
by(simp add: eq_equiv_class_iff2[OF equiv_EqF])


subsection‹Homomorphism and isomorphism›

definition is_pr_Hom :: "('a  'b)  'a Fgraph  'b Fgraph  bool" where
"is_pr_Hom φ Fs1 Fs2  (map φ ` Fs1)//{≅} = Fs2 //{≅}"

definition is_pr_Iso :: "('a  'b)  'a Fgraph  'b Fgraph  bool" where
"is_pr_Iso φ Fs1 Fs2  is_pr_Hom φ Fs1 Fs2  inj_on φ (F  Fs1. set F)"

definition is_pr_iso :: "('a  'b)  'a fgraph  'b fgraph  bool" where
"is_pr_iso φ Fs1 Fs2  is_pr_Iso φ (set Fs1) (set Fs2)"

text‹Homomorphisms preserve the set of nodes.›

lemma UN_subset_iff: "((iI. f i)  B) = (iI. f i  B)"
by blast

declare Image_Collect_case_prod[simp del]

lemma pr_Hom_pres_face_nodes:
 "is_pr_Hom φ Fs1 Fs2  (FFs1. {φ ` (set F)}) = (FFs2. {set F})"
supply image_cong_simp [cong del]
apply(clarsimp simp:is_pr_Hom_def quotient_def)
apply auto
apply(subgoal_tac "F'  Fs2. {≅} `` {map φ F} = {≅} `` {F'}")
 prefer 2 apply blast
apply (fastforce simp: eq_equiv_class_iff[OF equiv_EqF] dest!:congs_pres_nodes)
apply(subgoal_tac "F'  Fs1. {≅} `` {map φ F'} = {≅} `` {F}")
 apply (fastforce simp: eq_equiv_class_iff[OF equiv_EqF] dest!:congs_pres_nodes)
apply (erule equalityE)
apply(fastforce simp:UN_subset_iff)
done

lemma pr_Hom_pres_nodes:
  assumes "is_pr_Hom φ Fs1 Fs2"
  shows "φ ` (FFs1. set F) = (FFs2. set F)"
proof
  from assms have *: "(FFs1. {φ ` set F}) = (FFs2. {set F})"
    by (rule pr_Hom_pres_face_nodes)
  then show "φ ` (FFs1. set F)  (FFs2. set F)"
    by blast
  show "(FFs2. set F)  φ ` (FFs1. set F)"
  proof
    fix x
    assume "x  (FFs2. set F)"
    then obtain F where "F  Fs2" and "x  set F" ..
    then have "set F  (FFs2. {set F})"
      by blast
    then have "set F  (FFs1. {φ ` set F})"
      using * by simp
    then obtain F' where "F'  Fs1" and "set F  {φ ` set F'}" ..
    with x  set F show "x  φ ` (FFs1. set F)"
      by auto
  qed
qed

text‹Therefore isomorphisms preserve cardinality of node set.›

lemma pr_Iso_same_no_nodes:
  " is_pr_Iso φ Fs1 Fs2; finite Fs1 
    card(FFs1. set F) = card(FFs2. set F)"
by(clarsimp simp add: is_pr_Iso_def pr_Hom_pres_nodes[symmetric] card_image)

lemma pr_iso_same_no_nodes:
  "is_pr_iso φ Fs1 Fs2  card(Fset Fs1. set F) = card(Fset Fs2. set F)"
by(simp add: is_pr_iso_def pr_Iso_same_no_nodes)

text‹Isomorphisms preserve the number of faces.›

lemma pr_iso_same_no_faces:
  assumes dist1: "distinct Fs1" and dist2: "distinct Fs2"
  and inj1: "inj_on (λxs.{xs}//{≅}) (set Fs1)"
  and inj2: "inj_on (λxs.{xs}//{≅}) (set Fs2)" and iso: "is_pr_iso φ Fs1 Fs2"
  shows "length Fs1 = length Fs2"
proof -
  have injphi: "Fset Fs1. F'set Fs1. inj_on φ (set F  set F')" using iso
    by(auto simp:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def inj_on_def)
  have inj1': "inj_on (λxs. {xs} // {≅}) (map φ ` set Fs1)"
    apply(rule inj_on_imageI)
    apply(simp add:inj_on_def quotient_def eq_equiv_class_iff[OF equiv_EqF])
    apply(simp add: congs_map_eq_iff injphi)
    using inj1
    apply(simp add:inj_on_def quotient_def eq_equiv_class_iff[OF equiv_EqF])
    done
  have "length Fs1 = card(set Fs1)" by(simp add:distinct_card[OF dist1])
  also have " = card(map φ ` set Fs1)" using iso
    by(auto simp:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def inj_on_mapI card_image)
  also have " = card((map φ ` set Fs1) // {≅})"
    by(simp add: card_quotient_disjoint[OF _ inj1'])
  also have "(map φ ` set Fs1)//{≅} = set Fs2 // {≅}"
    using iso by(simp add: is_pr_iso_def is_pr_Iso_def is_pr_Hom_def)
  also have "card() = card(set Fs2)"
    by(simp add: card_quotient_disjoint[OF _ inj2])
  also have " = length Fs2" by(simp add:distinct_card[OF dist2])
  finally show ?thesis .
qed


lemma is_Hom_distinct:
 " is_pr_Hom φ Fs1 Fs2; FFs1. distinct F; FFs2. distinct F 
   FFs1. distinct(map φ F)"
apply(clarsimp simp add:is_pr_Hom_def)
apply(subgoal_tac " F'  Fs2. (map φ F, F') : {≅}")
 apply(fastforce simp add: congs_def)
apply(subgoal_tac " F'  Fs2. {map φ F}//{≅} = {F'}//{≅}")
 apply clarify
 apply(rule_tac x = F' in bexI)
  apply(rule eq_equiv_class[OF _ equiv_EqF])
   apply(simp add:singleton_quotient)
  apply blast
 apply assumption
apply(simp add:quotient_def)
apply(rotate_tac 1)
apply blast
done


lemma Collect_congs_eq_iff[simp]:
  "Collect ((≅) x) = Collect ((≅) y)  (x  (y::'a list))"
using eq_equiv_class_iff2[OF equiv_EqF]
apply(simp add: quotient_def Iso_def)
apply blast
done

lemma is_pr_Hom_trans: assumes f: "is_pr_Hom f A B" and g: "is_pr_Hom g B C"
shows "is_pr_Hom (g  f) A C"
proof-
  from f have f1: "aA. bB. map f a  b"
    apply(simp add: is_pr_Hom_def quotient_def Iso_def)
    apply(erule equalityE)
    apply blast
    done
  from f have f2: "bB. aA. map f a  b"
    apply(simp add: is_pr_Hom_def quotient_def Iso_def)
    apply(erule equalityE)
    apply blast
    done
  from g have g1: "bB. cC. map g b  c"
    apply(simp add: is_pr_Hom_def quotient_def Iso_def)
    apply(erule equalityE)
    apply blast
    done
  from g have g2: "cC. bB. map g b  c"
    apply(simp add: is_pr_Hom_def quotient_def Iso_def)
    apply(erule equalityE)
    apply blast
    done
  show ?thesis
    apply(auto simp add: is_pr_Hom_def quotient_def Iso_def Image_def
      map_comp_map[symmetric] image_comp simp del: map_map map_comp_map)
    apply (metis congs_map[of _ _ g] congs_trans f1 g1)
    by (metis congs_map[of _ _ g] congs_sym congs_trans f2 g2)
qed

lemma is_pr_Hom_rev:
  "is_pr_Hom φ A B  is_pr_Hom φ (rev ` A) (rev ` B)"
apply(auto simp add: is_pr_Hom_def quotient_def Image_def Iso_def rev_map[symmetric])
 apply(erule equalityE)
 apply blast
apply(erule equalityE)
apply blast
done


text‹A kind of recursion rule, a first step towards executability:›

lemma is_pr_Iso_rec:
 " inj_on (λxs. {xs}//{≅}) Fs1; inj_on (λxs. {xs}//{≅}) Fs2; F1  Fs1  
 is_pr_Iso φ Fs1 Fs2 =
 (F2  Fs2. length F1 = length F2  is_pr_Iso φ (Fs1 - {F1}) (Fs2 - {F2})
     (n. map φ F1 = rotate n F2)
     inj_on φ (FFs1. set F))"
apply(drule mk_disjoint_insert[of F1])
apply clarify
apply(rename_tac Fs1')
apply(rule iffI)

apply (clarsimp simp add:is_pr_Iso_def)
apply(clarsimp simp:is_pr_Hom_def quotient_diff1)
apply(drule_tac s="a // b" for a b in sym)
apply(clarsimp)
apply(subgoal_tac "{≅} `` {map φ F1} : Fs2 // {≅}")
 prefer 2 apply(simp add:quotient_def)
apply(erule quotientE)
apply(rename_tac F2)
apply(drule eq_equiv_class[OF _ equiv_EqF])
 apply blast
apply(rule_tac x = F2 in bexI)
 prefer 2 apply assumption
apply(rule conjI)
 apply(clarsimp simp: congs_def)
apply(rule conjI)
 apply(subgoal_tac "{≅} `` {F2} = {≅} `` {map φ F1}")
  prefer 2
  apply(rule equiv_class_eq[OF equiv_EqF])
  apply(fastforce intro: congs_sym)
 apply(subgoal_tac "{F2}//{≅} = {map φ F1}//{≅}")
  prefer 2 apply(simp add:singleton_quotient)
 apply(subgoal_tac "FFs1'. ¬ (map φ F)  (map φ F1)")
  apply(fastforce simp:Iso_def quotient_def Image_Collect_case_prod simp del: Collect_congs_eq_iff
                 dest!: eq_equiv_class[OF _ equiv_EqF])
 apply clarify
 apply(subgoal_tac "inj_on φ (set F  set F1)")
  prefer 2
  apply(erule subset_inj_on)
  apply(blast)
 apply(clarsimp simp add:congs_map_eq_iff)
 apply(subgoal_tac "{≅} `` {F1} = {≅} `` {F}")
  apply(simp add:singleton_quotient)
 apply(rule equiv_class_eq[OF equiv_EqF])
 apply(blast intro:congs_sym)
apply(subgoal_tac "F2  (map φ F1)")
 apply (simp add:congs_def inj_on_Un)
apply(clarsimp intro!:congs_sym)

apply(clarsimp simp add: is_pr_Iso_def is_pr_Hom_def quotient_diff1)
apply (simp add:singleton_quotient)
apply(subgoal_tac "F2  (map φ F1)")
 prefer 2 apply(fastforce simp add:congs_def)
apply(subgoal_tac "{≅}``{map φ F1} = {≅}``{F2}")
 prefer 2
 apply(rule equiv_class_eq[OF equiv_EqF])
 apply(fastforce intro:congs_sym)
apply(subgoal_tac "{≅}``{F2}  Fs2 // {≅}")
 prefer 2 apply(erule quotientI)
apply (simp add:insert_absorb quotient_def)
done


lemma is_iso_Cons:
 " distinct (F1#Fs1'); distinct Fs2;
    inj_on (λxs.{xs}//{≅}) (set(F1#Fs1')); inj_on (λxs.{xs}//{≅}) (set Fs2) 
  
 is_pr_iso φ (F1#Fs1') Fs2 =
 (F2  set Fs2. length F1 = length F2  is_pr_iso φ Fs1' (remove1 F2 Fs2)
     (n. map φ F1 = rotate n F2)
     inj_on φ (set F1  (Fset Fs1'. set F)))"
apply(simp add:is_pr_iso_def)
apply(subst is_pr_Iso_rec[where ?F1.0 = F1])
apply(simp_all)
done


subsection‹Isomorphism tests›

lemma map_upd_submap:
  "x  dom m  (m(x  y) m m') = (m' x = Some y  m m m')"
apply(simp add:map_le_def dom_def)
apply(rule iffI)
 apply(rule conjI) apply (blast intro:sym)
 apply clarify
 apply(case_tac "a=x")
  apply auto
done

lemma map_of_zip_submap: " length xs = length ys; distinct xs  
 (map_of (zip xs ys) m Some  f) = (map f xs = ys)"
apply(induct rule: list_induct2)
 apply(simp)
apply (clarsimp simp: map_upd_submap simp del:o_apply fun_upd_apply)
apply simp
done

primrec pr_iso_test0 :: "('a  'b)  'a fgraph  'b fgraph  bool" where
  "pr_iso_test0 m [] Fs2 = (Fs2 = [])"
| "pr_iso_test0 m (F1#Fs1) Fs2 =
   (F2  set Fs2. length F1 = length F2 
      (n. let m' = map_of(zip F1 (rotate n F2)) in
          if m m m ++ m'  inj_on (m++m') (dom(m++m'))
          then pr_iso_test0 (m ++ m') Fs1 (remove1 F2 Fs2) else False))"

lemma map_compatI: " f m Some  h; g m Some  h   f m f++g"
by (fastforce simp add: map_le_def map_add_def dom_def split:option.splits)

lemma inj_on_map_addI1:
 " inj_on m A; m m m++m'; A  dom m   inj_on (m++m') A"
apply (clarsimp simp add: inj_on_def map_add_def map_le_def dom_def
                split:option.splits)
apply(rule conjI)
 apply fastforce
apply auto
 apply fastforce
apply (rename_tac x a y)
apply(subgoal_tac "m x = Some a")
 prefer 2 apply (fastforce)
apply(subgoal_tac "m y = Some a")
 prefer 2 apply (fastforce)
apply(subgoal_tac "m x = m y")
 prefer 2 apply simp
apply (blast)
done

lemma map_image_eq: " A  dom m; m m m'   m ` A = m' ` A"
by(force simp:map_le_def dom_def split:option.splits)

lemma inj_on_map_add_Un:
 " inj_on m (dom m); inj_on m' (dom m'); m m Some  f; m' m Some  f;
    inj_on f (dom m'  dom m); A = dom m'; B = dom m 
   inj_on (m ++ m') (A  B)"
apply(simp add:inj_on_Un)
apply(rule conjI)
 apply(fastforce intro!: inj_on_map_addI1 map_compatI)
apply(clarify)
apply(subgoal_tac "m ++ m' m Some  f")
 prefer 2 apply(fast intro:map_add_le_mapI map_compatI)
apply(subgoal_tac "dom m' - dom m  dom(m++m')")
 prefer 2 apply(fastforce)
apply(insert map_image_eq[of "dom m' - dom m" "m++m'" "Some  f"])
apply(subgoal_tac "dom m - dom m'  dom(m++m')")
 prefer 2 apply(fastforce)
apply(insert map_image_eq[of "dom m - dom m'" "m++m'" "Some  f"])
apply (clarsimp simp add: image_comp [symmetric])
apply blast
done

lemma map_of_zip_eq_SomeD: "length xs = length ys 
  map_of (zip xs ys) x = Some y  y  set ys"
apply(induct rule:list_induct2)
 apply simp
apply (auto split:if_splits)
done

lemma inj_on_map_of_zip:
  " length xs = length ys; distinct ys 
    inj_on (map_of (zip xs ys)) (set xs)"
apply(induct rule:list_induct2)
 apply simp
apply clarsimp
apply(rule conjI)
 apply(erule inj_on_fun_updI)
 apply(simp add:image_def)
 apply clarsimp
 apply(drule (1) map_of_zip_eq_SomeD[OF _ sym])
 apply fast
apply(clarsimp simp add:image_def)
apply(drule (1) map_of_zip_eq_SomeD[OF _ sym])
apply fast
done

lemma pr_iso_test0_correct: "m Fs2.
  Fset Fs1. distinct F; Fset Fs2. distinct F;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2); inj_on m (dom m)  
       pr_iso_test0 m Fs1 Fs2 =
       (φ. is_pr_iso φ Fs1 Fs2  m m Some  φ 
            inj_on φ (dom m  (Fset Fs1. set F)))"
apply(induct Fs1)
 apply(simp add:inj_on_def dom_def)
 apply(rule iffI)
  apply (simp add:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def)
  apply(rule_tac x = "the  m" in exI)
  apply (fastforce simp: map_le_def)
 apply (clarsimp simp:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def)
apply(rename_tac F1 Fs1' m Fs2)
apply(clarsimp simp:Let_def Ball_def)
apply(simp add: is_iso_Cons)
apply(rule iffI)

apply clarify
apply(clarsimp simp add:map_of_zip_submap inj_on_diff)
apply(rule_tac x = φ in exI)
apply(rule conjI)
 apply(rule_tac x = F2 in bexI)
  prefer 2 apply assumption
 apply(frule map_add_le_mapE)
 apply(simp add:map_of_zip_submap is_pr_iso_def is_pr_Iso_def)
 apply(rule conjI)
  apply blast
 apply(erule subset_inj_on)
 apply blast
 apply(rule conjI)
  apply(blast intro: map_le_trans)
 apply(erule subset_inj_on)
 apply blast

apply(clarsimp simp: inj_on_diff)
apply(rule_tac x = F2 in bexI)
 prefer 2 apply assumption
apply simp
apply(rule_tac x = n in exI)
apply(rule conjI)
apply clarsimp
apply(rule_tac x = φ in exI)
apply simp
apply(rule conjI)
 apply(fastforce intro!:map_add_le_mapI simp:map_of_zip_submap)
apply(simp add:Un_ac)
apply(rule context_conjI)
apply(simp add:map_of_zip_submap[symmetric])
apply(erule (1) map_compatI)
apply(simp add:map_of_zip_submap[symmetric])
apply(erule inj_on_map_add_Un)
     apply(simp add:inj_on_map_of_zip)
    apply assumption
   apply assumption
  apply simp
  apply(erule subset_inj_on)
  apply fast
 apply simp
apply(rule refl)
done

corollary pr_iso_test0_corr:
 " Fset Fs1. distinct F; Fset Fs2. distinct F;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2)  
       pr_iso_test0 Map.empty Fs1 Fs2 = (φ. is_pr_iso φ Fs1 Fs2)"
apply(subst pr_iso_test0_correct)
 apply assumption+
 apply simp
apply (simp add:is_pr_iso_def is_pr_Iso_def)
done

text‹Now we bound the number of rotations needed. We have to exclude
the empty face @{term"[]"} to be able to restrict the search to
@{prop"n < length xs"} (which would otherwise be vacuous).›

primrec pr_iso_test1 :: "('a  'b)  'a fgraph  'b fgraph  bool" where
  "pr_iso_test1 m [] Fs2 = (Fs2 = [])"
| "pr_iso_test1 m (F1#Fs1) Fs2 =
   (F2  set Fs2. length F1 = length F2 
      (n < length F2. let m' = map_of(zip F1 (rotate n F2)) in
          if  m m m ++ m'  inj_on (m++m') (dom(m++m'))
          then pr_iso_test1 (m ++ m') Fs1 (remove1 F2 Fs2) else False))"

lemma test0_conv_test1:
 "m Fs2. []  set Fs2  pr_iso_test1 m Fs1 Fs2 = pr_iso_test0 m Fs1 Fs2"
apply(induct Fs1)
 apply simp
apply simp
apply(rule iffI)
 apply blast
apply (clarsimp simp:Let_def)
apply(rule_tac x = F2 in bexI)
 prefer 2 apply assumption
apply simp
apply(subgoal_tac "F2  []")
 prefer 2 apply blast
apply(rule_tac x = "n mod length F2" in exI)
apply(simp add:rotate_conv_mod[symmetric])
done

text‹Thus correctness carries over to pr_iso_test1›:›

corollary pr_iso_test1_corr:
 " Fset Fs1. distinct F; Fset Fs2. distinct F; []  set Fs2;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2)  
       pr_iso_test1 Map.empty Fs1 Fs2 = (φ. is_pr_iso φ Fs1 Fs2)"
by(simp add: test0_conv_test1 pr_iso_test0_corr)

subsubsection‹Implementing maps by lists›

text‹The representation are lists of pairs with no repetition in the
first or second component.›

definition oneone :: "('a * 'b)list  bool" where
"oneone xys    distinct(map fst xys)  distinct(map snd xys)"
declare oneone_def[simp]

type_synonym
  ('a,'b)tester = "('a * 'b)list  ('a * 'b)list  bool"
type_synonym
  ('a,'b)merger = "('a * 'b)list  ('a * 'b)list  ('a * 'b)list"

primrec pr_iso_test2 :: "('a,'b)tester  ('a,'b)merger 
                ('a * 'b)list  'a fgraph  'b fgraph  bool" where
  "pr_iso_test2 tst mrg I [] Fs2 = (Fs2 = [])"
| "pr_iso_test2 tst mrg I (F1#Fs1) Fs2 =
   (F2  set Fs2. length F1 = length F2 
      (n < length F2. let I' = zip F1 (rotate n F2) in
          if  tst I' I
          then pr_iso_test2 tst mrg (mrg I' I) Fs1 (remove1 F2 Fs2) else False))"

lemma notin_range_map_of:
 "y  snd ` set xys  Some y  range(map_of xys)"
apply(induct xys)
 apply (simp add:image_def)
apply(clarsimp split:if_splits)
done


lemma inj_on_map_upd:
  " inj_on m (dom m); Some y  range m   inj_on (m(xy)) (dom m)"
apply(simp add:inj_on_def dom_def image_def)
apply (blast intro:sym)
done

lemma [simp]:
 "distinct(map snd xys)  inj_on (map_of xys) (dom(map_of xys))"
apply(induct xys)
 apply simp
apply (simp add: notin_range_map_of inj_on_map_upd)
apply(clarsimp simp add:image_def)
apply(drule map_of_SomeD)
apply fastforce
done

lemma lem: "Ball (set xs) P  Ball (set (remove1 x xs)) P = True"
by(induct xs) simp_all

lemma pr_iso_test2_conv_1:
  "I Fs2.
   I I'. oneone I  oneone I' 
           tst I' I = (let m = map_of I; m' = map_of I'
                       in m m m ++ m'  inj_on (m++m') (dom(m++m')));
   I I'. oneone I  oneone I'  tst I' I
           map_of(mrg I' I) = map_of I ++ map_of I';
   I I'. oneone I  oneone I'  tst I' I  oneone (mrg I' I);
   oneone I;
   F  set Fs1. distinct F; F  set Fs2. distinct F  
  pr_iso_test2 tst mrg I Fs1 Fs2 = pr_iso_test1 (map_of I) Fs1 Fs2"
apply(induct Fs1)
 apply simp
apply(simp add:Let_def lem inj_on_map_of_zip del: mod_less cong: conj_cong)
done

text‹A simple implementation›

definition compat :: "('a,'b)tester" where
 "compat I I' ==
  (x,y)  set I. (x',y')  set I'. (x = x') = (y = y')"

lemma image_map_upd:
  "x  dom m  m(xy) ` A = m ` (A-{x})  (if x  A then {Some y} else {})"
by(auto simp:image_def dom_def)


lemma image_map_of_conv_Image:
 "A.  distinct(map fst xys) 
  map_of xys ` A = Some ` (set xys `` A)  (if A  fst ` set xys then {} else {None})"
supply image_cong_simp [cong del]
apply (induct xys)
 apply (simp add:image_def Image_def Collect_conv_if)
apply (simp add:image_map_upd dom_map_of_conv_image_fst)
apply(erule thin_rl)
apply (clarsimp simp:image_def Image_def)
apply((rule conjI, clarify)+, fastforce)
apply fastforce
apply(clarify)
apply((rule conjI, clarify)+, fastforce)
apply fastforce
apply fastforce
apply fastforce
done


lemma [simp]: "m++m' ` (dom m' - A) = m' ` (dom m' - A)"
apply(clarsimp simp add:map_add_def image_def dom_def inj_on_def split:option.splits)
apply auto
apply (blast intro:sym)
apply (blast intro:sym)
apply (rule_tac x = xa in bexI)
prefer 2 apply blast
apply simp
done

declare Diff_subset [iff]

lemma compat_correct:
 " oneone I; oneone I'  
  compat I' I = (let m = map_of I; m' = map_of I'
                 in m m m ++ m'  inj_on (m++m') (dom(m++m')))"
apply(simp add: compat_def Let_def map_le_iff_map_add_commute)
apply(rule iffI)
 apply(rule context_conjI)
  apply(rule ext)
  apply (fastforce simp add:map_add_def split:option.split)
 apply(simp add:inj_on_Un)
 apply(drule sym)
 apply simp
 apply(simp add: dom_map_of_conv_image_fst image_map_of_conv_Image)
 apply(simp add: image_def Image_def)
 apply fastforce
apply clarsimp
apply(rename_tac a b aa ba)
apply(rule iffI)
 apply (clarsimp simp: fun_eq_iff)
 apply(erule_tac x = aa in allE)
 apply (simp add:map_add_def)
apply (clarsimp simp:dom_map_of_conv_image_fst)
apply(simp (no_asm_use) add:inj_on_def)
apply(drule_tac x = a in bspec)
 apply force
apply(drule_tac x = aa in bspec)
 apply force
apply(erule mp)
apply simp
apply(drule sym)
apply simp
done

corollary compat_corr:
 "I I'. oneone I  oneone I' 
         compat I' I = (let m = map_of I; m' = map_of I'
                      in m m m ++ m'  inj_on (m++m') (dom(m++m')))"
by(simp add: compat_correct)

definition merge0 :: "('a,'b)merger" where
"merge0 I' I    [xy  I'. fst xy  fst ` set I] @ I"


lemma help1:
"distinct(map fst xys)  map_of (filter P xys) =
 map_of xys |` {x. y. (x,y)  set xys  P(x,y)}"
apply(induct xys)
 apply simp
apply(rule ext)
apply (simp add:restrict_map_def)
apply force
done

lemma merge0_correct:
  "I I'. oneone I  oneone I'  compat I' I
   map_of(merge0 I' I) = map_of I ++ map_of I'"
apply(simp add:compat_def merge0_def help1 fun_eq_iff map_add_def restrict_map_def split:option.split)
apply fastforce
done

lemma merge0_inv:
  "I I'. oneone I  oneone I'  compat I' I  oneone (merge0 I' I)"
apply(auto simp add:merge0_def distinct_map compat_def split_def)
apply(blast intro:subset_inj_on)+
done

corollary pr_iso_test2_corr:
 " Fset Fs1. distinct F; Fset Fs2. distinct F; []  set Fs2;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2)  
       pr_iso_test2 compat merge0 [] Fs1 Fs2 = (φ. is_pr_iso φ Fs1 Fs2)"
by(simp add: pr_iso_test2_conv_1[OF compat_corr merge0_correct merge0_inv]
             pr_iso_test1_corr)

text‹Implementing merge as a recursive function:›

primrec merge :: "('a,'b)merger" where
  "merge [] I = I"
| "merge (xy#xys) I = (let (x,y) = xy in
    if  (x',y')  set I. x  x' then xy # merge xys I else merge xys I)"

lemma merge_conv_merge0: "merge I' I = merge0 I' I"
apply(induct I')
 apply(simp add:merge0_def)
apply(force simp add:Let_def list_all_iff merge0_def)
done


primrec pr_iso_test_rec :: "('a * 'b)list  'a fgraph  'b fgraph  bool" where
  "pr_iso_test_rec I [] Fs2 = (Fs2 = [])"
| "pr_iso_test_rec I (F1#Fs1) Fs2 =
   ( F2  set Fs2. length F1 = length F2 
      (n < length F2. let I' = zip F1 (rotate n F2) in
          compat I' I  pr_iso_test_rec (merge I' I) Fs1 (remove1 F2 Fs2)))"

lemma pr_iso_test_rec_conv_2:
  "I Fs2. pr_iso_test_rec I Fs1 Fs2 = pr_iso_test2 compat merge0 I Fs1 Fs2"
apply(induct Fs1)
 apply simp
apply(auto simp: merge_conv_merge0 list_ex_iff Bex_def Let_def)
done

corollary pr_iso_test_rec_corr:
 " Fset Fs1. distinct F; Fset Fs2. distinct F; []  set Fs2;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2)  
       pr_iso_test_rec [] Fs1 Fs2 = (φ. is_pr_iso φ Fs1 Fs2)"
by(simp add: pr_iso_test_rec_conv_2 pr_iso_test2_corr)

definition pr_iso_test :: "'a fgraph  'b fgraph  bool" where
"pr_iso_test Fs1 Fs2 = pr_iso_test_rec [] Fs1 Fs2"

corollary pr_iso_test_correct:
 " Fset Fs1. distinct F; Fset Fs2. distinct F; []  set Fs2;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2)  
  pr_iso_test Fs1 Fs2 = (φ. is_pr_iso φ Fs1 Fs2)"
apply(simp add:pr_iso_test_def pr_iso_test_rec_corr)
done

subsubsection‹`Improper' Isomorphisms›

definition is_Iso :: "('a  'b)  'a Fgraph  'b Fgraph  bool" where
"is_Iso φ Fs1 Fs2  is_pr_Iso φ Fs1 Fs2  is_pr_Iso φ Fs1 (rev ` Fs2)"

definition is_iso :: "('a  'b)  'a fgraph  'b fgraph  bool" where
"is_iso φ Fs1 Fs2  is_Iso φ (set Fs1) (set Fs2)"

definition iso_fgraph :: "'a fgraph  'a fgraph  bool" (infix "" 60) where
"g1  g2    φ. is_iso φ g1 g2"


lemma iso_fgraph_trans: assumes "f  (g::'a fgraph)" and "g  h" shows "f  h"
proof-
  { fix φ φ' assume "is_pr_Hom φ (set f) (set g)" "inj_on φ (Fset f. set F)"
    "is_pr_Hom φ' (set g) (set h)" "inj_on φ' (Fset g. set F)"
    hence "is_pr_Hom (φ'  φ) (set f) (set h) 
          inj_on (φ'  φ) (Fset f. set F)"
      by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
  } moreover
  { fix φ φ' assume "is_pr_Hom φ (set f) (set g)" "inj_on φ (Fset f. set F)"
    "is_pr_Hom φ' (set g) (rev ` set h)" "inj_on φ' (Fset g. set F)"
    hence "is_pr_Hom (φ'  φ) (set f) (rev ` set h) 
          inj_on (φ'  φ) (Fset f. set F)"
      by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
  } moreover
  { fix φ φ' assume "is_pr_Hom φ (set f) (rev ` set g)" "inj_on φ (Fset f. set F)"
    "is_pr_Hom φ' (set g) (set h)" "inj_on φ' (Fset g. set F)"
    with this(3)[THEN is_pr_Hom_rev]
    have "is_pr_Hom (φ'  φ) (set f) (rev ` set h) 
          inj_on (φ'  φ) (Fset f. set F)"
      by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
  } moreover
  { fix φ φ' assume "is_pr_Hom φ (set f) (rev ` set g)" "inj_on φ (Fset f. set F)"
    "is_pr_Hom φ' (set g) (rev ` set h)" "inj_on φ' (Fset g. set F)"
    with this(3)[THEN is_pr_Hom_rev]
    have "is_pr_Hom (φ'  φ) (set f) (set h) 
          inj_on (φ'  φ) (Fset f. set F)"
      by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
  } ultimately show ?thesis using assms
    by(simp add: iso_fgraph_def is_iso_def is_Iso_def is_pr_Iso_def) blast
qed



definition iso_test :: "'a fgraph  'b fgraph  bool" where
"iso_test g1 g2  pr_iso_test g1 g2  pr_iso_test g1 (map rev g2)"

theorem iso_correct:
 " Fset Fs1. distinct F; Fset Fs2. distinct F; []  set Fs2;
   distinct Fs1; inj_on (λxs.{xs}//{≅}) (set Fs1);
   distinct Fs2; inj_on (λxs.{xs}//{≅}) (set Fs2)  
  iso_test Fs1 Fs2 = (Fs1  Fs2)"
apply(simp add:iso_test_def pr_iso_test_correct iso_fgraph_def)
apply(subst pr_iso_test_correct)
       apply simp
      apply simp
     apply (simp add:image_def)
    apply simp
   apply simp
  apply (simp add:distinct_map)
 apply (simp add:inj_on_image_iff)
apply(simp add:is_iso_def is_Iso_def is_pr_iso_def)
apply blast
done

lemma iso_fgraph_refl[iff]: "g  g"
apply(simp add: iso_fgraph_def)
apply(rule_tac x = "id" in exI)
apply(simp add: is_iso_def is_Iso_def is_pr_Iso_def is_pr_Hom_def id_def)
done


subsection‹Elementhood and containment modulo›

interpretation qle_gr: quasi_order "(≃)"
proof qed (auto intro:iso_fgraph_trans)

abbreviation qle_gr_in :: "'a fgraph  'a fgraph set  bool"  (infix "" 60)
where "x  M  qle_gr.in_qle x M"
abbreviation qle_gr_sub :: "'a fgraph set  'a fgraph set  bool"  (infix "" 60)
where "x  M  qle_gr.subseteq_qle x M"
abbreviation qle_gr_eq :: "'a fgraph set  'a fgraph set  bool"  (infix "=" 60)
where "x = M  qle_gr.seteq_qle x M"

end

Theory Rotation

(*  Author:     Tobias Nipkow
*)

section ‹More Rotation›

theory Rotation
imports ListAux PlaneGraphIso
begin

definition rotate_to :: "'a list  'a  'a list" where
"rotate_to vs v   v # snd (splitAt v vs) @ fst (splitAt v vs)"

definition rotate_min :: "nat list  nat list" where
"rotate_min vs  rotate_to vs (min_list vs)"


lemma cong_rotate_to:
 "x  set xs  xs  rotate_to xs x"
proof -
  assume x: "x  set xs"
  hence ls1: "xs = fst (splitAt x xs) @ x # snd (splitAt x xs)" by (auto dest: splitAt_ram)
  define i where "i = length(fst(splitAt x xs))"
  hence "i < length((fst(splitAt x xs)) @ [x] @ snd(splitAt x xs))" by auto
  with ls1 have i_len: "i < length xs" by auto
  hence ls2: "xs = take i xs @ xs!i # drop (Suc i) xs" by (auto intro: id_take_nth_drop)
  from i_len have "length (take i xs) = i" by auto
  with i_def have len_eq: "length(take i xs) = length(fst(splitAt x xs))" by auto
  moreover
  from ls1 ls2 have eq: "take i xs @ xs!i # drop (Suc i) xs = fst(splitAt x xs) @ x # snd(splitAt x xs)" by simp
  ultimately have
    v_simp: "x = xs!i" and
    take_i: "fst(splitAt x xs) = take i xs" and
    drop_i': "snd(splitAt x xs) = drop (Suc i) xs" by auto
  from i_len have ls3: "xs = take i xs @ drop i xs" by auto
  with take_i have eq: "xs = fst(splitAt x xs) @ drop i xs" by auto
  with ls1 have "fst(splitAt x xs) @ drop i xs = fst(splitAt x xs) @ x # snd(splitAt x xs)" by auto
  then have drop_i: "drop i xs = x # snd(splitAt x xs)" by auto
  have "rotate i xs = drop (i mod length xs) xs @ take (i mod length xs) xs" by (rule rotate_drop_take)
  with i_len have "rotate i xs = drop i xs @ take i xs" by auto
  with take_i drop_i have "rotate i xs = (x # snd(splitAt x xs)) @ fst(splitAt x xs)" by auto
  thus ?thesis apply (auto simp: congs_def rotate_to_def) apply (rule exI) apply (rule sym) .
qed

lemma face_cong_if_norm_eq:
 " rotate_min xs = rotate_min ys; xs  []; ys  []   xs  ys"
apply(simp add:rotate_min_def)
apply(subgoal_tac "xs  rotate_to xs (Min (set xs))")
 apply(subgoal_tac "ys  rotate_to ys (Min (set ys))")
  apply(simp) apply(blast intro:congs_sym congs_trans)
 apply(simp add: cong_rotate_to)
apply(drule sym)
apply(simp add: cong_rotate_to)
done

lemma norm_eq_if_face_cong:
  " xs  ys; distinct xs; xs  []   rotate_min xs = rotate_min ys"
by(auto simp:congs_def rotate_min_def rotate_to_def
  splitAt_rotate_pair_conv insert_absorb)

lemma norm_eq_iff_face_cong:
 " distinct xs; xs  []; ys  []  
  (rotate_min xs = rotate_min ys) = (xs  ys)"
by(blast intro: face_cong_if_norm_eq norm_eq_if_face_cong)

lemma inj_on_rotate_min_iff:
assumes "vs  A. distinct vs"  "[]  A"
shows "inj_on rotate_min A = inj_on (λvs. {vs}//{≅}) A"
proof -
  { fix xs ys assume xs: "xs  A" and ys : "ys  A"
    hence "xs  []  ys  []" using assms(2) by blast
    hence "(rotate_min xs = rotate_min ys) = (xs  ys)"
      using xs assms(1)
      by(simp add: singleton_list_cong_eq_iff norm_eq_iff_face_cong)
  } thus ?thesis by(simp add:inj_on_def)
qed


end

Theory Graph

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section ‹Graph›

theory Graph
imports Rotation
begin

syntax
  "_UNION1"     :: "pttrns  'b set  'b set"           ("(3(‹unbreakable›_)/ _)" [0, 10] 10)
  "_INTER1"     :: "pttrns  'b set  'b set"           ("(3(‹unbreakable›_)/ _)" [0, 10] 10)
  "_UNION"      :: "pttrn  'a set  'b set  'b set"  ("(3(‹unbreakable›__)/ _)" [0, 0, 10] 10)
  "_INTER"      :: "pttrn  'a set  'b set  'b set"  ("(3(‹unbreakable›__)/ _)" [0, 0, 10] 10)


subsection‹Notation›

type_synonym vertex = "nat"

consts
  vertices :: "'a  vertex list"
  edges :: "'a  (vertex × vertex) set" ("")

abbreviation vertices_set :: "'a  vertex set" ("𝒱") where
  "𝒱 f  set (vertices f)"


subsection ‹Faces›

text ‹
We represent faces by (distinct) lists of vertices and a face type.
›

datatype facetype = Final | Nonfinal

datatype face = Face "(vertex list)"  facetype

consts final :: "'a  bool"
consts type :: "'a  facetype"

overloading
  final_face  "final :: face  bool"
  type_face  "type :: face  facetype"
  vertices_face  "vertices :: face  vertex list"
  cong_face  "pr_isomorphic :: face  face  bool"
begin

primrec final_face where
  "final (Face vs f) = (case f of Final  True | Nonfinal  False)"

primrec type_face where
  "type (Face vs f) = f"

primrec vertices_face where
  "vertices (Face vs f) = vs"

definition cong_face :: "face  face  bool"
  where "(f1 :: face)  f2  vertices f1  vertices f2"

end

text ‹The following operation makes a face final.›

definition setFinal :: "face  face" where
  "setFinal f  Face (vertices f) Final"


text ‹The function nextVertex› (written f ∙ v›) is based on
nextElem›, that returns the successor of an element in a list.›

primrec nextElem :: "'a list  'a  'a  'a" where
 "nextElem [] b x = b"
|"nextElem (a#as) b x =
    (if x=a then (case as of []  b | (a'#as')  a') else nextElem as b x)"

definition nextVertex :: "face  vertex  vertex" (*<*)("_ " [999]) (*>*)where (* *)
 "f   let vs = vertices f in nextElem vs (hd vs)"


text nextVertices› is $n$-fold application of
nextvertex›.›

definition nextVertices :: "face  nat  vertex  vertex" (*<*)("__  _" [100, 0, 100]) (*>*)where (* *)
  "fn  v  (f  ^^ n) v"

lemma nextV2: "f2v = f (f v)"
by (simp add: nextVertices_def eval_nat_numeral)

(*<*)
overloading edges_face  "edges :: face  (vertex × vertex) set"
begin
  definition " f  {(a, f  a)|a. a  𝒱 f}"
end
(*>*)

(*<*)consts op :: "'a  'a" ("_op" [1000] 999)  (*>*) (* *)
overloading op_vertices  "Graph.op :: vertex list  vertex list"
begin
  definition "(vs::vertex list)op  rev vs"
end

overloading op_graph  "Graph.op :: face  face"
begin
  primrec op_graph where "(Face vs f)op = Face (rev vs) f"
end

(*<*)
lemma [simp]: "vertices ((f::face)op) = (vertices f)op"
  by (induct f) (simp add: op_vertices_def)
lemma [simp]: "xs  []  hd (rev xs)= last xs"
  by(induct xs) simp_all (*>*) (* *)

definition prevVertex :: "face  vertex  vertex" (*<*)("_-1 " [100]) (*>*)where (* *)
  "f-1  v  (let vs = vertices f in nextElem (rev vs) (last vs) v)"

abbreviation
  triangle :: "face  bool" where
  "triangle f == |vertices f| = 3"


subsection ‹Graphs›

datatype graph = Graph "(face list)" "nat" "face list list" "nat list"

primrec faces :: "graph  face list" where
  "faces (Graph fs n f h) = fs"

abbreviation
  Faces :: "graph  face set" ("") where
  " g == set(faces g)"

primrec countVertices :: "graph  nat" where
  "countVertices (Graph fs n f h) = n"

overloading
  vertices_graph  "vertices :: graph  vertex list"
begin
  primrec vertices_graph where "vertices (Graph fs n f h) = [0 ..< n]"
end

lemma vertices_graph: "vertices g = [0 ..< countVertices g]"
by (induct g) simp

lemma in_vertices_graph:
  "v  set (vertices g) = (v < countVertices g)"
by (simp add:vertices_graph)

lemma len_vertices_graph:
  "|vertices g| = countVertices g"
by (simp add:vertices_graph)

primrec faceListAt :: "graph  face list list" where
  "faceListAt (Graph fs n f h) = f"

definition facesAt :: "graph  vertex  face list" where
 "facesAt g v  ⌦‹if v ∈ set(vertices g) then› faceListAt g ! v ⌦‹else []›"

primrec heights :: "graph  nat list" where
  "heights (Graph fs n f h) = h"

definition height :: "graph  vertex  nat" where
  "height g v  heights g ! v"

definition graph :: "nat  graph" where
  "graph n 
    (let vs = [0 ..< n];
     fs = [ Face vs Final, Face (rev vs) Nonfinal]
     in (Graph fs n (replicate n fs) (replicate n 0)))"

subsection‹Operations on graphs›

text ‹final graph, final / nonfinal faces›

definition finals :: "graph  face list" where
  "finals g  [f  faces g. final f]"

definition nonFinals :: "graph  face list" where
  "nonFinals g  [f  faces g. ¬ final f]"

definition countNonFinals :: "graph  nat" where
  "countNonFinals g  |nonFinals g|"

overloading finalGraph  "final :: graph  bool"
begin
  definition "finalGraph g  (nonFinals g = [])"
end

lemma finalGraph_faces[simp]: "final g  finals g = faces g"
 by (simp add: finalGraph_def finals_def nonFinals_def filter_compl1)

lemma finalGraph_face: "final g  f  set (faces g)  final f"
  by (simp only: finalGraph_faces[symmetric]) (simp add: finals_def)


definition finalVertex :: "graph  vertex  bool" where
  "finalVertex g v  f  set(facesAt g v). final f"

lemma finalVertex_final_face[dest]:
  "finalVertex g v  f  set (facesAt g v)  final f"
  by (auto simp add: finalVertex_def)




text ‹counting faces›

definition degree :: "graph  vertex  nat" where
  "degree g v  |facesAt g v|"

definition tri :: "graph  vertex  nat" where
 "tri g v  |[f  facesAt g v. final f  |vertices f| = 3]|"

definition quad :: "graph  vertex  nat" where
 "quad g v  |[f  facesAt g v. final f  |vertices f| = 4]|"

definition except :: "graph  vertex  nat" where
 "except g v  |[f  facesAt g v. final f  5  |vertices f| ]|"

definition vertextype :: "graph  vertex  nat × nat × nat" where
  "vertextype g v  (tri g v, quad g v, except g v)"

lemma[simp]: "0  tri g v" by (simp add: tri_def)

lemma[simp]: "0  quad g v" by (simp add: quad_def)

lemma[simp]: "0  except g v" by (simp add: except_def)


definition exceptionalVertex :: "graph  vertex  bool" where
  "exceptionalVertex g v  except g v  0"

definition noExceptionals :: "graph  vertex set  bool" where
  "noExceptionals g V  (v  V. ¬ exceptionalVertex g v)"


text ‹An edge $(a,b)$ is contained in face f,
  $b$ is the successor of $a$ in $f$.›
(*>*)
overloading edges_graph  "edges :: graph  (vertex × vertex) set"
begin
  definition " (g::graph)  f   g edges f"
end

definition neighbors :: "graph  vertex  vertex list" where
 "neighbors g v  [fv. f  facesAt g v]"


subsection ‹Navigation in graphs›

text ‹
The function $s'$ permutating the faces at a vertex,
is implemeted by the function nextFace›

definition nextFace :: "graph × vertex  face  face" (*<*)("_ ") (*>*)where
(*<*) nextFace_def_aux: "p   λf. (let (g,v) = p; fs = (facesAt g v) in
   (case fs of []  f
           | g#gs  nextElem fs (hd fs) f))"  (*>*)


(* precondition a b in f *)
definition directedLength :: "face  vertex  vertex  nat" where
  "directedLength f a b 
  if a = b then 0 else |(between (vertices f) a b)| + 1"


subsection ‹Code generator setup›

definition final_face :: "face  bool" where
  final_face_code_def: "final_face = final"
declare final_face_code_def [symmetric, code_unfold]

lemma final_face_code [code]:
  "final_face (Face vs Final)  True"
  "final_face (Face vs Nonfinal)  False"
  by (simp_all add: final_face_code_def)

definition final_graph :: "graph  bool" where
  final_graph_code_def: "final_graph = final"
declare final_graph_code_def [symmetric, code_unfold]

lemma final_graph_code [code]: "final_graph g = List.null (nonFinals g)"
  unfolding final_graph_code_def finalGraph_def null_def ..

definition vertices_face :: "face  vertex list" where
  vertices_face_code_def: "vertices_face = vertices"
declare vertices_face_code_def [symmetric, code_unfold]

lemma vertices_face_code [code]: "vertices_face (Face vs f) = vs"
  unfolding vertices_face_code_def by simp

definition vertices_graph :: "graph  vertex list" where
  vertices_graph_code_def: "vertices_graph = vertices"
declare vertices_graph_code_def [symmetric, code_unfold]

lemma vertices_graph_code [code]:
  "vertices_graph (Graph fs n f h) = [0 ..< n]"
  unfolding vertices_graph_code_def by simp

end

Theory IArray_Syntax

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section ‹Syntax for operations on immutable arrays›

theory IArray_Syntax
imports Main "HOL-Library.IArray"
begin

subsection ‹Tabulation›

definition tabulate :: "nat  (nat  'a)  'a iarray"
where
  "tabulate n f = IArray.of_fun f n"

definition tabulate2 :: "nat  nat  (nat  nat  'a)  'a iarray iarray"
where
  "tabulate2 m n f = IArray.of_fun (λi .IArray.of_fun (f i) n) m "

definition tabulate3 :: "nat  nat  nat  
  (nat  nat  nat  'a)  'a iarray iarray iarray" where
  "tabulate3 l m n f  IArray.of_fun (λi. IArray.of_fun (λj. IArray.of_fun (λk. f i j k) n) m) l"

syntax 
 "_tabulate" :: "'a  pttrn  nat  'a iarray"  ("(_. _ < _)") 
 "_tabulate2" :: "'a  pttrn  nat  pttrn  nat  'a iarray"
   ("(_. _ < _, _ < _)")
 "_tabulate3" :: "'a  pttrn  nat  pttrn  nat  pttrn  nat  'a iarray"
   ("(_. _ < _, _ < _, _ < _ )")

translations 
  "f. x < n" == "CONST tabulate n (λx. f)"
  "f. x < m, y < n" == "CONST tabulate2 m n (λx y. f)"
  "f. x < l, y < m, z < n" == "CONST tabulate3 l m n (λx y z. f)"


subsection ‹Access›

abbreviation sub1_syntax :: "'a iarray  nat  'a"  ("(__)" [1000] 999)
where
  "an  IArray.sub a n"

abbreviation sub2_syntax :: "'a iarray iarray  nat  nat  'a"  ("(__,_)" [1000] 999)
where
  "asm, n  IArray.sub (IArray.sub as m) n"

abbreviation sub3_syntax :: "'a iarray iarray iarray  nat  nat  nat  'a"  ("(__,_,_)" [1000] 999)
where
  "asl, m, n  IArray.sub (IArray.sub (IArray.sub as l) m) n"

text ‹examples:  @{term "0. i < 5"}, @{term "i. i < 5, j < 3"}

end

Theory Enumerator

(*  Author:     Gertrud Bauer
*)

section ‹Enumerating Patches›

theory Enumerator
imports Graph IArray_Syntax
begin

text ‹
Generates an Enumeration of lists. 
(See Kepler98, PartIII, section 8, p.11).

Used to construct all possible extensions of an unfinished outer
 face $F$ with $outer$ vertices
by a new finished inner face with $inner$ vertices, such a fixed 
edge $e$ of the outer face is also contained in the inner face. 

Label the vertices  of $F$ consecutively 
$0, \ldots, outer-1$, with $0$ and $outer-1$ the endpoints of $e$.

Generate all lists $$[a0, \ldots,  a_{inner_1}]$$ of length
 $inner$, 
%such that $0 = a_0 \le a_1 \ldots a_{outer - 2} < a_{outer -1}$.
such that $0 = a_0 \le a_1 \ldots a_{inner - 2} < a_{inner -1}$.
Every list represents an inner face, with vertices
 $v_0, \ldots, v_{inner-1}$. 

Construct the vertices $v_0, \ldots, v_{inner - 1}$ inductively:
If $i = 1$ or $a_i \not = a_{i -1}$, we set $v_i$ to the vertex 
with index
$a_i$ of F. But if  $a_i = a_{i -1}$, we add a new vertex $v_i$ 
to the planar map.
The new face is to be drawn along the edge $e$ over the face $F$.

As we run over all $inner$ and all lists
 $[a0, \ldots,  a_{inner_1}]$, 
we run over all osibilites fro the finishe face along the edge
 $e$ inside $F$.
›

text‹\paragraph{Executable enumeration of patches}›

definition enumBase :: "nat  nat list list" where
 "enumBase nmax  [[i]. i  [0 ..< Suc nmax]]"

definition enumAppend :: "nat  nat list list  nat list list" where
 "enumAppend nmax iss isiss [is @ [n]. n  [last is ..< Suc nmax]]"

definition enumerator :: "nat  nat  nat list list" where (* precondition inner ≥ 3 *)
 "enumerator inner outer 
     let nmax = outer - 2; k = inner - 3 in 
     [[0] @ is @ [outer - 1]. is  (enumAppend nmax ^^ k) (enumBase nmax)]"    

definition enumTab :: "nat list list iarray iarray" where
"enumTab   enumerator inner outer. inner < 9, outer < 9 "

(* never used with > 8 but easier this way *)
definition enum :: "nat  nat  nat list list" where
"enum inner outer  if inner < 9  outer < 9 then enumTabinner,outer
                    else enumerator inner outer"

text‹\paragraph{Conversion to list of vertices}›

primrec hideDupsRec :: "'a  'a list  'a option list" where
  "hideDupsRec a [] = []"
| "hideDupsRec a (b#bs) = 
     (if a = b then None # hideDupsRec b bs 
     else Some b # hideDupsRec b bs)"    

primrec hideDups :: "'a list  'a option list" where
  "hideDups [] = []"
| "hideDups (b#bs) = Some b # hideDupsRec b bs"

definition indexToVertexList :: "face  vertex  nat list  vertex option list" where (* precondition hd is = 0 *)
 "indexToVertexList f v is  hideDups [fkv. k  is]" 

end

Theory FaceDivision

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section‹Subdividing a Face›

theory FaceDivision
imports Graph
begin

definition split_face :: "face  vertex  vertex  vertex list  face × face" where
 "split_face f ram1 ram2 newVs  let vs = vertices f;
     f1 = [ram1] @ between vs ram1 ram2 @ [ram2];
     f2 = [ram2] @ between vs ram2 ram1 @ [ram1] in
     (Face (rev newVs @ f1) Nonfinal,
     Face (f2 @ newVs) Nonfinal)"


definition replacefacesAt :: "nat list  face  face list  face list list  face list list" where
 "replacefacesAt ns f fs F  mapAt ns (replace f fs) F"


definition makeFaceFinalFaceList :: "face  face list  face list" where
  "makeFaceFinalFaceList f fs  replace f [setFinal f] fs"

definition makeFaceFinal :: "face  graph  graph" where
 "makeFaceFinal f g 
     Graph (makeFaceFinalFaceList f (faces g))
           (countVertices g)
           [makeFaceFinalFaceList f fs. fs  faceListAt g]
           (heights g)"


definition heightsNewVertices :: "nat  nat  nat  nat list" where
 "heightsNewVertices h1 h2 n  [min (h1 + i + 1) (h2 + n - i). i  [0 ..< n]]"

definition splitFace
 :: "graph  vertex  vertex  face  vertex list  face × face × graph" where
 "splitFace g ram1 ram2 oldF newVs 
     let fs = faces g;
     n = countVertices g;
     Fs = faceListAt g;
     h = heights g;
     vs1 = between (vertices oldF) ram1 ram2;
     vs2 = between (vertices oldF) ram2 ram1;
     (f1, f2) = split_face oldF ram1 ram2 newVs;
     Fs = replacefacesAt vs1 oldF [f1] Fs;
     Fs = replacefacesAt vs2 oldF [f2] Fs;
     Fs = replacefacesAt [ram1] oldF [f2, f1] Fs;
     Fs = replacefacesAt [ram2] oldF [f1, f2] Fs;
     Fs = Fs @ replicate |newVs| [f1, f2] in
     (f1, f2, Graph ((replace oldF [f2] fs)@ [f1])
                        (n + |newVs| )
                        Fs
                        (h @ heightsNewVertices (h!ram1)(h!ram2) |newVs| ))"



primrec subdivFace' :: "graph  face  vertex  nat  vertex option list  graph" where
  "subdivFace' g f u n [] = makeFaceFinal f g"
| "subdivFace' g f u n (vo#vos) =
     (case vo of None  subdivFace' g f u (Suc n) vos
         | (Some v) 
            if fu = v  n = 0
            then subdivFace' g f v 0 vos
            else let ws = [countVertices g  ..< countVertices g + n];
            (f1, f2, g') = splitFace g u v f ws in
            subdivFace' g' f2 v 0 vos)"

definition subdivFace :: "graph  face  vertex option list  graph" where
"subdivFace g f vos  subdivFace' g f (the(hd vos)) 0 (tl vos)"

end

Theory RTranCl

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section ‹Transitive Closure of Successor List Function›

theory RTranCl
imports Main
begin

text‹The reflexive transitive closure of a relation induced by a
function of type @{typ"'a  'a list"}. Instead of defining the closure
again it would have been simpler to take @{term"{(x,y) . y  set(f x)}*"}.›

abbreviation (input)
  in_set :: "'a  ('a  'b list)  'b  bool" ("_ [_]→ _" [55,0,55] 50) where
  "g [succs]→ g' == g'  set (succs g)"

inductive_set
  RTranCl :: "('a  'a list)  ('a * 'a) set"
  and in_RTranCl :: "'a  ('a  'a list)  'a  bool"
    ("_ [_]→* _" [55,0,55] 50)
  for succs :: "'a  'a list"
where
  "g [succs]→* g'  (g,g')  RTranCl succs"
| refl: "g [succs]→* g"
| succs: "g [succs]→ g'  g' [succs]→* g''  g [succs]→* g''"

inductive_cases RTranCl_elim: "(h,h') : RTranCl succs"

lemma RTranCl_induct(*<*) [induct set: RTranCl, consumes 1, case_names refl succs] (*>*):
 "(h, h')  RTranCl succs  
  P h  
  (g g'. g'  set (succs g)  P g  P g')  
  P h'"
proof -
  assume s: "g g'. g'  set (succs g)  P g  P g'"
  assume "(h, h')  RTranCl succs" "P h"
  then show "P h'"
  proof (induct rule: RTranCl.induct)
    fix g assume "P g" then show "P g" . 
  next
    fix g g' g''
    assume IH: "P g'  P g''"
    assume "g'  set(succs g)" "P g"
    then have "P g'" by (rule s)
    then show "P g''" by (rule IH)
  qed
qed

definition invariant :: "('a  bool)  ('a  'a list)  bool" where
"invariant P succs  g g'. g'  set(succs g)  P g  P g'"

lemma invariantE:
  "invariant P succs   g [succs]→ g'  P g  P g'"
by(simp add:invariant_def)

lemma inv_subset:
 "invariant P f  (g. P g  set(f' g)  set(f g))  invariant P f'"
by(auto simp:invariant_def)

lemma RTranCl_inv:
  "invariant P succs  (g,g')  RTranCl succs  P g  P g'"
by (erule RTranCl_induct)(auto simp:invariant_def)

lemma RTranCl_subset2:
assumes a: "(s,g) : RTranCl f"
shows "(g. (s,g)  RTranCl f  set(f g)  set(h g))  (s,g) : RTranCl h"
using a
proof (induct rule: RTranCl.induct)
  case refl show ?case by(rule RTranCl.intros)
next
  case succs thus ?case by(blast intro: RTranCl.intros)
qed

end

Theory Plane

(*  Author:     Gertrud Bauer
*)

section‹Plane Graph Enumeration›

theory Plane
imports Enumerator FaceDivision RTranCl
begin


definition maxGon :: "nat  nat" where
"maxGon p  p+3"

declare maxGon_def [simp]


definition duplicateEdge :: "graph  face  vertex  vertex  bool" where
 "duplicateEdge g f a b  
  2  directedLength f a b  2  directedLength f b a  b  set (neighbors g a)"

primrec containsUnacceptableEdgeSnd :: 
      "(nat  nat  bool)  nat  nat list  bool" where
 "containsUnacceptableEdgeSnd N v [] = False" |
 "containsUnacceptableEdgeSnd N v (w#ws) = 
     (case ws of []  False
         | (w'#ws')  if v < w  w < w'  N w w' then True
                      else containsUnacceptableEdgeSnd N w ws)"

primrec containsUnacceptableEdge :: "(nat  nat  bool)  nat list  bool" where
 "containsUnacceptableEdge N [] = False" |
 "containsUnacceptableEdge N (v#vs) =
     (case vs of []  False
           | (w#ws)  if v < w  N v w then True
                      else containsUnacceptableEdgeSnd N v vs)"

definition containsDuplicateEdge :: "graph  face  vertex  nat list  bool" where
 "containsDuplicateEdge g f v is  
     containsUnacceptableEdge (λi j. duplicateEdge g f (fiv) (fjv)) is" 

definition containsDuplicateEdge' :: "graph  face  vertex  nat list  bool" where
 "containsDuplicateEdge' g f v is  
  2  |is|  
  ((k < |is| - 2. let i0 = is!k; i1 = is!(k+1); i2 = is!(k+2) in
    (duplicateEdge g f (fi1 v) (fi2 v))  (i0 < i1)  (i1 < i2))
   (let i0 = is!0; i1 = is!1 in
    (duplicateEdge g f (fi0 v) (fi1 v))  (i0 < i1)))" 


definition generatePolygon :: "nat  vertex  face  graph  graph list" where
 "generatePolygon n v f g  
     let enumeration = enumerator n |vertices f|;
     enumeration = [is  enumeration. ¬ containsDuplicateEdge g f v is];
     vertexLists = [indexToVertexList f v is. is  enumeration] in
     [subdivFace g f vs. vs  vertexLists]"

definition next_plane0 :: "nat  graph  graph list" ("next'_plane0⇘_") where
 "next_plane0p g 
     if final g then [] 
     elsefnonFinals gvvertices fi[3..<Suc(maxGon p)] generatePolygon i v f g"


definition Seed :: "nat  graph" ("Seed⇘_") where
  "Seedp  graph(maxGon p)"

lemma Seed_not_final[iff]: "¬ final (Seed p)"
by(simp add:Seed_def graph_def finalGraph_def nonFinals_def)

definition PlaneGraphs0 :: "graph set" where 
"PlaneGraphs0  p. {g. Seedp [next_plane0p]→* g  final g}"

end

Theory Plane1

(*  Title:      Plane1.thy
    Author:     Gertrud Bauer, Tobias Nipkow

Fixing a single face and vertex in each refinement step.
*)

theory Plane1
imports Plane
begin

text‹This is an optimized definition of plane graphs and the one we
adopt as our point of reference. In every step only one fixed nonfinal
face (the smallest one) and one edge in that face are picked.›


definition minimalFace :: "face list  face" where
 "minimalFace  minimal (length  vertices)"

definition minimalVertex :: "graph  face  vertex" where
 "minimalVertex g f  minimal (height g) (vertices f)" 

definition next_plane :: "nat  graph  graph list" ("next'_plane⇘_") where
 "next_planep g 
     let fs = nonFinals g in
     if fs = [] then [] 
     else let f = minimalFace fs; v = minimalVertex g f ini[3..<Suc(maxGon p)] generatePolygon i v f g"

definition PlaneGraphsP :: "nat  graph set" ("PlaneGraphs⇘_") where
"PlaneGraphsp  {g. Seedp [next_planep]→* g  final g}"

definition PlaneGraphs :: "graph set" where
"PlaneGraphs  p. PlaneGraphsp"

end

Theory GraphProps

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section‹Properties of Graph Utilities›

theory GraphProps
imports Graph
begin

declare [[linarith_neq_limit = 3]]

lemma final_setFinal[iff]: "final(setFinal f)"
by (simp add:setFinal_def)


lemma eq_setFinal_iff[iff]: "(f = setFinal f) = final f"
proof (induct f)
  case (Face f t)
  then show ?case
    by (cases t) (simp_all add: setFinal_def)
qed

lemma setFinal_eq_iff[iff]: "(setFinal f = f) = final f"
by (blast dest:sym intro:sym)


lemma distinct_vertices[iff]: "distinct(vertices(g::graph))"
by(induct g) simp


subsection@{const nextElem}

lemma nextElem_append[simp]:
 "y  set xs  nextElem (xs @ ys) d y = nextElem ys d y"
by(induct xs) auto

lemma nextElem_cases:
"nextElem xs d x = y 
 x  set xs  y = d 
 xs  []  x = last xs  y = d  x  set(butlast xs) 
 (us vs. xs = us @ [x,y] @ vs  x  set us)"
apply(induct xs)
 apply simp
apply simp
apply(split if_splits)
 apply(simp split:list.splits)
 apply(rule_tac x = "[]" in exI)
 apply simp
apply simp
apply(erule disjE)
 apply simp
apply(erule disjE)
 apply clarsimp
apply(rule conjI)
 apply clarsimp
apply (clarsimp)
apply(erule_tac x = "a#us" in allE)
apply simp
done


lemma nextElem_notin_butlast[rule_format,simp]:
 "y  set(butlast xs)  nextElem xs x y = x"
by(induct xs) auto

lemma nextElem_in: "nextElem xs x y : set(x#xs)"
apply (induct xs)
 apply simp
apply auto
apply(clarsimp split: list.splits)
apply(clarsimp split: list.splits)
done

lemma nextElem_notin[simp]: "a  set as  nextElem as c a = c"
by(erule nextElem_append[where ys = "[]", simplified])

lemma nextElem_last[simp]: assumes dist: "distinct xs"
shows "nextElem xs c (last xs) = c"
proof cases
  assume "xs = []" thus ?thesis by simp
next
  let ?xs = "butlast xs @ [last xs]"
  assume xs: "xs  []"
  with dist have "distinct ?xs" by simp
  hence notin: "last xs  set(butlast xs)" by simp
  from xs have "nextElem xs c (last xs) = nextElem ?xs c (last xs)" by simp
  also from notin have " = c" by simp
  finally show ?thesis .
qed


lemma prevElem_nextElem:
assumes dist: "distinct xs" and xxs: "x : set xs"
shows "nextElem (rev xs) (last xs) (nextElem xs (hd xs) x) = x"
proof -
  define x' where "x' = nextElem xs (hd xs) x"
  hence nE: "nextElem xs (hd xs) x = x'" by simp
  have "xs  []  x = last xs  x' = hd xs  (us vs. xs = us @ [x, x'] @ vs)"
    (is "?A  ?B")
    using nextElem_cases[OF nE] xxs by blast
  thus ?thesis
  proof
    assume ?A
    thus ?thesis using dist by(clarsimp simp:neq_Nil_conv)
  next
    assume ?B
    then obtain us vs where [simp]: "xs = us @ [x, x'] @ vs" by blast
    thus ?thesis using dist by simp
  qed
qed

lemma nextElem_prevElem:
 " distinct xs; x : set xs  
  nextElem xs (hd xs) (nextElem (rev xs) (last xs) x) = x"
apply(cases "xs = []")
 apply simp
using prevElem_nextElem[where xs = "rev xs" and x=x]
apply(simp add:hd_rev last_rev)
done


lemma nextElem_nth:
 "i. distinct xs; i < length xs 
    nextElem xs z (xs!i) = (if length xs = i+1 then z else xs!(i+1))"
apply(induct xs) apply simp
apply(case_tac i)
 apply(simp split:list.split)
apply clarsimp
done


subsection nextVertex›

lemma nextVertex_in_face'[simp]:
  "vertices f  []  f  v  𝒱 f"
proof -
  assume f: "vertices f  []"
  define c where "c = nextElem (vertices f) (hd (vertices f)) v"
  then have "nextElem (vertices f) (hd (vertices f)) v = c" by auto
  with f show ?thesis
    apply (simp add: nextVertex_def)
    apply (drule_tac nextElem_cases)
    apply(fastforce simp:neq_Nil_conv)
    done
qed

lemma nextVertex_in_face[simp]:
  "v  set (vertices f)  f  v  𝒱 f"
 by (auto intro: nextVertex_in_face')


lemma nextVertex_prevVertex[simp]:
 " distinct(vertices f); v  𝒱 f 
  f  (f-1  v) = v"
by(simp add:prevVertex_def nextVertex_def nextElem_prevElem)

lemma prevVertex_nextVertex[simp]:
 " distinct(vertices f); v  𝒱 f 
  f-1  (f  v) = v"
by(simp add:prevVertex_def nextVertex_def prevElem_nextElem)

lemma prevVertex_in_face[simp]:
 "v  𝒱 f  f-1  v  𝒱 f"
apply(cases "vertices f = []")
 apply simp
using nextElem_in[of "rev (vertices f)" "(last (vertices f))" v]
apply (auto simp add: prevVertex_def)
done

lemma nextVertex_nth:
 " distinct(vertices f); i < |vertices f|  
  f  (vertices f ! i) = vertices f ! ((i+1) mod |vertices f| )"
apply(cases "vertices f = []") apply simp
apply(simp add:nextVertex_def nextElem_nth hd_conv_nth)
done


subsection ℰ›

lemma edges_face_eq:
 "((a,b)   (f::face)) = ((f  a = b)  a  𝒱 f)"
by (auto simp add: edges_face_def)


lemma edges_setFinal[simp]: "(setFinal f) =  f"
by(induct f)(simp add:setFinal_def edges_face_def nextVertex_def)

lemma in_edges_in_vertices:
 "(x,y)  (f::face)  x  𝒱 f  y  𝒱 f"
apply(simp add:edges_face_eq nextVertex_def)
apply(cut_tac xs= "vertices f" and x= "hd(vertices f)" and y=x in nextElem_in)
apply(cases "vertices f")
apply(auto)
done


lemma vertices_conv_Union_edges:
 "𝒱(f::face) = ((a,b) f. {a})"
apply(induct f)
apply(simp add:vertices_face_def edges_face_def)
apply blast
done


lemma nextVertex_in_edges: "v  𝒱 f  (v, f  v)  edges f"
by(auto simp:edges_face_def)

lemma prevVertex_in_edges:
 "distinct(vertices f); v  𝒱 f  (f-1  v, v)  edges f"
by(simp add:edges_face_eq)


subsection ‹Triangles›

lemma vertices_triangle:
   "|vertices f| = 3  a  𝒱 f 
  distinct (vertices f) 
  𝒱 f = {a, f  a, f  (f  a)}"
proof -
  assume "|vertices f| = 3"
  then obtain a1 a2 a3 where "vertices f = [a1, a2, a3]"
    by (auto dest!:  length3D)
  moreover assume "a  𝒱 f"
  moreover assume "distinct (vertices f)"
  ultimately show ?thesis
    by (simp, elim disjE) (auto simp add: nextVertex_def)
qed

(* could be generalized from 3 to n
   but presburger would no longer do the job *)
lemma tri_next3_id:
 "|vertices f| = 3  distinct(vertices f)  v  𝒱 f
   f  (f  (f  v)) = v"
apply(subgoal_tac "(i::nat) < 3. (((((i+1) mod 3)+1) mod 3)+1) mod 3 = i")
 apply(clarsimp simp:in_set_conv_nth nextVertex_nth)
apply(presburger)
done


lemma triangle_nextVertex_prevVertex:
 "|vertices f| = 3  a  𝒱 f 
  distinct (vertices f) 
  f  (f  a) = f-1  a"
proof -
  assume "|vertices f| = 3"
  then obtain a1 a2 a3 where "vertices f = [a1, a2, a3]"
    by (auto dest!:length3D)
  moreover assume "a  𝒱 f"
  moreover assume "distinct (vertices f)"
  ultimately show ?thesis
    by (simp, elim disjE) (auto simp add: nextVertex_def prevVertex_def)
qed

subsection ‹Quadrilaterals›


lemma vertices_quad:
  "|vertices f| = 4  a  𝒱 f 
  distinct (vertices f) 
  𝒱 f = {a, f  a, f  (f  a), f  (f  (f  a))}"
proof -
  assume "|vertices f| = 4"
  then obtain a1 a2 a3 a4 where "vertices f = [a1, a2, a3, a4]"
    by (auto dest!: length4D)
  moreover assume "a  𝒱 f"
  moreover assume "distinct (vertices f)"
  ultimately show ?thesis
    by (simp, elim disjE) (auto simp add: nextVertex_def)
qed

lemma quad_next4_id:
 " |vertices f| = 4; distinct(vertices f); v  𝒱 f  
  f  (f  (f  (f  v))) = v"
apply(subgoal_tac "(i::nat) < 4.
 (((((((i+1) mod 4)+1) mod 4)+1) mod 4)+1) mod 4 = i")
 apply(clarsimp simp:in_set_conv_nth nextVertex_nth)
apply(presburger)
done


lemma quad_nextVertex_prevVertex:
 "|vertices f| = 4  a  𝒱 f  distinct (vertices f) 
  f  (f  (f  a)) = f-1  a"
proof -
  assume "|vertices f| = 4"
  then obtain a1 a2 a3 a4 where "vertices f = [a1, a2, a3, a4]"
    by (auto dest!: length4D)
  moreover assume "a  𝒱 f"
  moreover assume "distinct (vertices f)"
  ultimately show ?thesis
    by (auto) (auto simp add: nextVertex_def prevVertex_def)
qed

(*
lemma C0[dest]: "f ∈ set (facesAt g v) ⟹ v ∈ 𝒱 g"
  by (simp add: facesAt_def split: if_split_asm)
*)

lemma len_faces_sum: "|faces g| = |finals g| + |nonFinals g|"
by(simp add:finals_def nonFinals_def sum_length_filter_compl)


lemma graph_max_final_ex:
 "fset (finals (graph n)). |vertices f| = n"
proof (induct "n")
  case 0 then show ?case by (simp add: graph_def finals_def)
next
  case (Suc n) then show ?case
   by (simp add: graph_def finals_def)
qed


subsection‹No loops›

lemma distinct_no_loop2:
 " distinct(vertices f); v  𝒱 f; u  𝒱 f; u  v   f  v  v"
apply(frule split_list[of v])
apply(clarsimp simp: nextVertex_def neq_Nil_conv hd_append
  split:list.splits if_split_asm)
done

lemma distinct_no_loop1:
 " distinct(vertices f); v  𝒱 f; |vertices f| > 1   f  v  v"
apply(subgoal_tac "u  𝒱 f. u  v")
 apply(blast dest:distinct_no_loop2)
apply(cases "vertices f") apply simp
apply(rename_tac a as)
apply (clarsimp simp:neq_Nil_conv)
done


subsection@{const between}

lemma between_front[simp]:
 "v  set us  between (u # us @ v # vs) u v = us"
by(simp add:between_def split_def)

lemma between_back:
 " v  set us; u  set vs; v  u   between (v # vs @ u # us) u v = us"
by(simp add:between_def split_def)


lemma next_between:
 "distinct(vertices f); v  𝒱 f; u  𝒱 f; f  v  u 
   f  v  set(between (vertices f) v u)"
apply(frule split_list[of u])
apply(clarsimp)
apply(erule disjE)
 apply(clarsimp simp:set_between_id nextVertex_def hd_append split:list.split)
apply(erule disjE)
 apply(frule split_list[of v])
 apply(clarsimp simp: between_def split_def nextVertex_def split:list.split)
 apply(clarsimp simp:append_eq_Cons_conv)
apply(frule split_list[of v])
apply(clarsimp simp: between_def split_def nextVertex_def split:list.split)
apply(clarsimp simp: hd_append)
done


lemma next_between2:
 " distinct(vertices f); v  𝒱 f; u  𝒱 f; u  v  
  v  set(between (vertices f) u (f  v))"
apply(frule split_list[of u])
apply(clarsimp)
apply(erule disjE)
 apply(clarsimp simp: nextVertex_def hd_append split:list.split)
 apply(rule conjI)
  apply(clarsimp)
 apply(frule split_list[of v])
 apply(clarsimp simp: between_def split_def split:list.split)
 apply(fastforce simp: append_eq_Cons_conv)
apply(frule split_list[of v])
apply(clarsimp simp: between_def split_def nextVertex_def split:list.splits)
apply(clarsimp simp: hd_append)
apply(erule disjE)
 apply(clarsimp)
apply(frule split_list)
apply(fastforce)
done


(* distinctness seems not to be necessary but simplifies the proof *)
lemma between_next_empty:
 "distinct(vertices f)  between (vertices f) v (f  v) = []"
apply(cases "v  𝒱 f")
 apply(frule split_list)
 apply(clarsimp simp:between_def split_def nextVertex_def
   neq_Nil_conv hd_append split:list.split)
 apply(clarsimp simp:between_def split_def nextVertex_def)
apply(cases "vertices f")
 apply simp
apply simp
done


lemma unroll_between_next2:
 " distinct(vertices f); u  𝒱 f; v  𝒱 f; u  v  
  between (vertices f) u (f  v) = between (vertices f) u v @ [v]"
using split_between[OF _ _ _ next_between2]
by (simp add: between_next_empty split:if_split_asm)


lemma nextVertex_eq_lemma:
 " distinct(vertices f); x  𝒱 f; y  𝒱 f; x  y;
    v  set(x # between (vertices f) x y)  
  f  v = nextElem (x # between (vertices f) x y @ [y]) z v"
apply(drule split_list[of x])
apply(simp add:nextVertex_def)
apply(erule disjE)
 apply(clarsimp)
 apply(erule disjE)
  apply(drule split_list)
  apply(clarsimp simp add:between_def split_def hd_append split:list.split)
  apply(fastforce simp:append_eq_Cons_conv)
 apply(drule split_list)
 apply(clarsimp simp add:between_def split_def hd_append split:list.split)
 apply(fastforce simp:append_eq_Cons_conv)
apply(clarsimp)
 apply(erule disjE)
 apply(drule split_list[of y])
 apply(clarsimp simp:between_def split_def)
 apply(erule disjE)
  apply(drule split_list[of v])
  apply(fastforce simp: hd_append neq_Nil_conv split:list.split)
 apply(drule split_list[of v])
 apply(clarsimp)
 apply(clarsimp simp: hd_append split:list.split)
 apply(fastforce simp:append_eq_Cons_conv)
apply(drule split_list[of y])
apply(clarsimp simp:between_def split_def)
apply(drule split_list[of v])
apply(clarsimp)
apply(clarsimp simp: hd_append split:list.split)
apply(clarsimp simp:append_eq_Cons_conv)
apply(fastforce simp: hd_append neq_Nil_conv split:list.split)
done

end

Theory EnumeratorProps

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section‹Properties of Patch Enumeration›

theory EnumeratorProps
imports Enumerator GraphProps
begin

lemma length_hideDupsRec[simp]: "x. length(hideDupsRec x xs) = length xs"
by(induct xs) auto

lemma length_hideDups[simp]: "length(hideDups xs) = length xs"
by(cases xs) simp_all

lemma length_indexToVertexList[simp]:
 "length(indexToVertexList x y xs) = length xs"
by(simp add:indexToVertexList_def)


(***************************** List not decreasing ***************************)
definition increasing :: "('a::linorder) list  bool" where
 "increasing ls   x y as bs. ls = as @ x # y # bs  x  y"

lemma increasing1: " as x. increasing ls  ls = as @ x # cs @ y # bs  x  y"
proof (induct cs)
  case Nil then show ?case
    by (auto simp: increasing_def)
next
  case (Cons c cs) then show ?case
    apply (subgoal_tac "c  y")
    apply (force simp: increasing_def)
    apply (rule_tac Cons) by simp_all
qed

lemma increasing2: "increasing (as@bs)  x  set as  y  set bs  x  y"
proof-
  assume n:"increasing (as@bs)" and x:"x  set as" and y: "y  set bs"
  from x obtain as' as'' where as: "as = as' @ x # as''" by (auto simp: in_set_conv_decomp)
  from y obtain bs' bs'' where bs: "bs = bs' @ y # bs''" by (auto simp: in_set_conv_decomp)
  from n as bs show ?thesis
  apply (auto intro!: increasing1)
  apply (subgoal_tac "as' @ x # as'' @ bs' @ y # bs'' = as' @ x # (as'' @ bs') @ y # bs''")
  by (assumption) auto
qed

lemma increasing3: " as bs. (ls = as @ bs  ( x  set as.  y  set bs. x  y))  increasing (ls)"
apply (simp add: increasing_def) apply safe
proof -
  fix as bs x y
  assume p: "asa bsa. as @ x # y # bs = asa @ bsa  (xset asa. yset bsa. x  y)"
  then have p': " asa bsa. as @ x # y # bs = asa @ bsa  (xset asa. yset bsa. x  y)" by auto
  then have "(xset (as @ [x]). yset (y # bs). x  y)" by (rule_tac p') auto
  then show "x  y" by (auto simp: increasing_def)
qed

lemma increasing4: "increasing (as@bs)  increasing as"
apply (simp add: increasing_def) apply safe by auto

lemma increasing5: "increasing (as@bs)  increasing bs"
proof -
  assume nd: "increasing (as@bs)"
  then have r: " x y asa bsa. (asa bsa. as @ bs = asa @ x # y # bsa)  x  y" by (auto simp: increasing_def)
  show ?thesis apply (clarsimp simp add: increasing_def)
    apply (rule_tac r)
    apply (rule_tac x="as @ _" in exI)
    apply auto
    done
qed


(*********************************** EnumeratorProps *************************************)

(********** enumBase ***********)

lemma enumBase_length: "ls  set (enumBase nmax)  length ls = 1"
by (auto simp: enumBase_def)

lemma enumBase_bound: "y  set (enumBase nmax). z  set y. z  nmax"
by (auto simp: enumBase_def)

lemmas enumBase_simps = enumBase_length enumBase_bound


(********** enumAppend ************)

lemma enumAppend_bound: "ls  set ((enumAppend nmax) lss) 
  y  set lss.  z  set y. z  nmax  x  set ls  x   nmax"
by (auto simp add: enumAppend_def split: if_split_asm)


lemma enumAppend_bound_rec: "ls  set (((enumAppend nmax) ^^ n) lss) 
   y  set lss.  z  set y. z  nmax  x  set ls  x   nmax"
proof -
  assume ls: "ls  set ((enumAppend nmax ^^ n) lss)" and lss: "yset lss. zset y. z  nmax" and x: "x  set ls"
  have ind:" lss. yset lss. zset y. z  nmax   y  set (((enumAppend nmax) ^^ n) lss).  z  set y. z  nmax"
  proof (induct n)
    case 0 then show ?case by auto
  next
    case (Suc n) show ?case apply (intro ballI) apply (rule enumAppend_bound) by (auto intro!: Suc)
  qed
  with lss have " y  set (((enumAppend nmax) ^^ n) lss).  z  set y. z  nmax" apply (rule_tac ind) .
  with ls x show ?thesis by auto
qed

lemma enumAppend_increase_rec:
  " m as bs. ls  set (((enumAppend nmax) ^^ m) (enumBase nmax)) 
  as @ bs = ls    x  set as.  y  set bs. x  y"
apply (induct ls rule: rev_induct) apply force apply auto apply (case_tac "m") apply simp  apply (drule_tac enumBase_length)
apply (case_tac as) apply simp_all
proof -
  fix x xs m as bs xa xb n
  assume ih: "m as bs.
           xs  set ((enumAppend nmax ^^ m) (enumBase nmax)); as @ bs = xs
            xset as. xaset bs. x  xa"
    and xs:"xs @ [x]  set (enumAppend nmax ((enumAppend nmax ^^ n) (enumBase nmax)))"
    and asbs: "as @ bs = xs @ [x]" and xa:"xa  set as" and xb: "xb  set bs" and m: "m = Suc n"
  from ih have ih2: " as bs x y. xs  set ((enumAppend nmax ^^ n) (enumBase nmax)); as @ bs = xs; x  set as; y  set bs
            x  y" by auto

  from xb have "bs  []"  by auto
  then obtain bs' b where bs': "bs = bs' @ [b]" apply (cases rule: rev_exhaust) by auto
  with asbs have beq:"b = x" by auto
  from bs' asbs have xs': "as @ bs' = xs" by auto
  with xs have "xa  x"
  proof (cases "xs" rule: rev_exhaust)
    case Nil with xa xs' show ?thesis by auto
  next
    case (snoc ys y)
    have "xa  y"
    proof (cases "xa = y")
      case True then show ?thesis by auto
    next
      case False
      from xa xs' have "xa  set xs" by auto
      with False snoc have "xa  set ys" by auto
      with xs snoc  show ?thesis
        apply (rule_tac ih2)
        by (auto simp: enumAppend_def)
    qed
    with xs snoc show "xa  x" by (auto simp: enumAppend_def split:if_split_asm)
  qed
  then show "xa  xb" apply (cases "xb = b") apply (simp add: beq)
  proof (rule_tac ih2)
    from xs
    show "xs  set ((enumAppend nmax ^^ n) (enumBase nmax))"
    by (auto simp: enumAppend_def)
  next
    from xs' show "as @ bs' = xs" by auto
  next
    from xa show "xa  set as" by auto
  next
    assume "xb  b"
    with xb bs' show "xb  set bs'" by auto
  qed
qed

lemma enumAppend_length1: "ls. ls  set ((enumAppend nmax ^^ n) lss) 
 (l  set lss. |l| = k)  |ls| = k + n"
apply (induct n)
apply simp
by (auto simp add:enumAppend_def split: if_split_asm)

lemma enumAppend_length2: "ls. ls  set ((enumAppend nmax ^^ n) lss) 
 (l. l  set lss  |l| = k)  K = k + n  |ls| = K"
 by (auto simp add: enumAppend_length1)


(*********** enum *********)

lemma enum_enumerator:
 "enum i j = enumerator i j"
by(simp add: enum_def enumTab_def tabulate2_def tabulate_def)


(*********** enumerator *********)

lemma enumerator_hd: "ls  set (enumerator m n)  hd ls = 0"
by (auto simp: enumerator_def split: if_split_asm)

lemma enumerator_last: "ls  set (enumerator m n)  last ls = (n - 1)"
by (auto simp: enumerator_def split: if_split_asm)

lemma enumerator_length: "ls  set (enumerator m n)  2  length ls"
by (auto simp: enumerator_def split: if_split_asm)

lemmas set_enumerator_simps = enumerator_hd enumerator_last enumerator_length

lemma enumerator_not_empty[dest]: "ls  set (enumerator m n)  ls   []"
apply (subgoal_tac "2  length ls") apply force  by (rule enumerator_length)

lemma enumerator_length2: "ls  set (enumerator m n)  2 < m  length ls = m"
proof -
  assume ls:"ls  set (enumerator m n)" and m: "2 < m"
  define k where "k = m - 3"
  with m have k: "m = k + 3" by arith
  with ls have "ls  set (enumerator (k+3) n)" by auto
  then have "length ls = k + 3"
    apply (auto simp: enumerator_def enumBase_def)
    apply (erule enumAppend_length2) by auto
  with k show ?thesis by simp
qed

lemma enumerator_bound: "ls  set (enumerator m nmax) 
 0 < nmax  x  set ls  x < nmax"
apply (auto simp: enumerator_def split: if_split_asm)
apply (subgoal_tac "x  nmax - 2") apply arith
apply (rule_tac enumAppend_bound_rec) by(auto simp:enumBase_simps)

lemma enumerator_bound2: "ls  set (enumerator m nmax)  1 < nmax  x  set (butlast ls)  x < nmax - Suc 0"
apply (auto simp: enumerator_def split: if_split_asm)
apply (subgoal_tac "x   (nmax - 2)") apply arith
apply (rule_tac enumAppend_bound_rec) by(auto simp:enumBase_simps)

lemma enumerator_bound3: "ls  set (enumerator m nmax)  1 < nmax  last (butlast ls) < nmax - Suc 0"
apply (case_tac "ls" rule: rev_exhaust) apply force
apply (rule_tac enumerator_bound2) apply assumption
apply auto
apply (case_tac "ys" rule: rev_exhaust) apply simp
apply (subgoal_tac "2  length (ys @ [y])") apply simp
apply (rule_tac enumerator_length) by auto


lemma enumerator_increase: " as bs. ls  set (enumerator m nmax)   as @ bs = ls   x  set as.  y  set bs. x  y"
apply (auto simp: enumerator_def del: Nat.diff_is_0_eq' split: if_split_asm intro: enumAppend_increase_rec)
apply (case_tac as) apply simp apply simp
apply (case_tac bs rule: rev_exhaust)  apply simp apply simp apply auto
apply (drule_tac enumAppend_bound_rec) apply (auto simp:enumBase_simps)
by (auto dest!: enumAppend_increase_rec)

lemma enumerator_increasing: "ls  set (enumerator m nmax)  increasing ls"
apply (rule increasing3)
by (auto dest: enumerator_increase)

definition incrIndexList :: "nat list  nat  nat  bool" where
 "incrIndexList ls m nmax 
  1 < m  1 < nmax 
  hd ls = 0  last ls = (nmax - 1)  length ls = m
  last (butlast ls) < last ls  increasing ls"

lemma incrIndexList_1lem[simp]: "incrIndexList ls m nmax  Suc 0 < m"
by (unfold incrIndexList_def) simp

lemma incrIndexList_1len[simp]: "incrIndexList ls m nmax  Suc 0 < nmax"
by (unfold incrIndexList_def) simp

lemma incrIndexList_help2[simp]: "incrIndexList ls m nmax  hd ls = 0"
by (unfold incrIndexList_def) simp

lemma incrIndexList_help21[simp]: "incrIndexList (l # ls) m nmax  l = 0"
by (auto dest: incrIndexList_help2)

lemma incrIndexList_help3[simp]: "incrIndexList ls m nmax  last ls = (nmax - (Suc 0))"
by (unfold incrIndexList_def)  simp

lemma incrIndexList_help4[simp]: "incrIndexList ls m nmax  length ls = m "
by (unfold incrIndexList_def)  simp

lemma incrIndexList_help5[intro]: "incrIndexList ls m nmax   last (butlast ls) < nmax - Suc 0"
by (unfold incrIndexList_def) auto

lemma incrIndexList_help6[simp]: "incrIndexList ls m nmax  increasing ls"
by (unfold incrIndexList_def) simp

lemma incrIndexList_help7[simp]: "incrIndexList ls m nmax  ls  []"
apply (subgoal_tac "length ls   0") apply force
apply simp
apply (subgoal_tac "1 < m")  apply arith apply force done

lemma incrIndexList_help71[simp]: "¬ incrIndexList [] m nmax"
by (auto dest: incrIndexList_help7)

lemma incrIndexList_help8[simp]: "incrIndexList ls m nmax  butlast ls  []"
proof (rule ccontr)
  assume props: "incrIndexList ls m nmax" and butl: "¬ butlast ls  []"
  then have "ls  []" by auto
  then have ls': "ls = (butlast ls) @ [last ls]" by auto
  define l where "l = last ls"
  with butl ls' have "ls = [l]" by auto
  then have "length ls = 1" by auto
  with props have "m = 1" by auto
  with props show "False" by (auto dest: incrIndexList_1lem)
qed

lemma incrIndexList_help81[simp]: "¬ incrIndexList [l] m nmax"
by (auto dest: incrIndexList_help8)

lemma incrIndexList_help9[intro]: "(incrIndexList ls m nmax)  
  x  set (butlast ls)  x  nmax - 2"
proof -
  assume props: "(incrIndexList ls m nmax)"  and x: "x  set (butlast ls)"
  then have "last (butlast ls) < last ls" by auto
  with props have "last (butlast ls) < nmax - 1" by auto
  then have leq: "last (butlast ls)   nmax - 2" by arith
  from props  have "ls  []" by auto
  then have ls1: "ls = butlast ls @ [last ls]" by auto
  define ls' where "ls' = butlast (butlast ls)"
  define last2 where "last2 = last (butlast ls)"
  define last1 where "last1 = last ls"
  from props  have "butlast ls  []" by auto
  with ls'_def last2_def have bls: "butlast ls = ls' @ [last2]" by auto
  with last1_def ls1 props have ls3: "ls = ls' @ [last2] @ [last1]" by auto
  from props  have "increasing ls" by auto
  with ls3 have increasing: "increasing (ls' @ ([last2] @ [last1]))" by auto
  then have "x  set ls'  x  last2" by (auto intro: increasing2)
  then have "x  set (ls' @ [last2])  x  last2" by auto
  with bls x have "x  last2" by auto
  with leq last2_def show ?thesis by auto
qed


lemma incrIndexList_help10[intro]: "(incrIndexList ls m nmax)  
  x  set ls  x < nmax" apply (cases ls rule: rev_exhaust) apply auto
  apply (frule incrIndexList_help3) apply (auto dest: incrIndexList_1len)
  apply (frule incrIndexList_help9) apply auto apply (drule incrIndexList_1len)
  by arith

lemma enumerator_correctness: "2 < m  1 < nmax 
  ls  set (enumerator m nmax) 
  incrIndexList ls m nmax"
proof -
  assume m: "2 < m" and nmax: "1 < nmax" and enum: "ls  set (enumerator m nmax)"
  then have "(hd ls = 0  last ls = (nmax - 1)  length ls = m  last (butlast ls) < last ls   increasing ls)"
    by (auto intro: enumerator_increasing enumerator_hd enumerator_last enumerator_length2 enumerator_bound3 simp: set_enumerator_simps)
  with m nmax show ?thesis by (unfold incrIndexList_def) auto
qed

lemma enumerator_completeness_help: " ls. increasing ls  ls  []  length ls = Suc ks  list_all (λx. x < Suc nmax) ls  ls  set ((enumAppend nmax ^^ ks) (enumBase nmax))"
proof (induct ks)
  case 0
  assume "increasing ls" "ls  []" "length ls = Suc 0" "list_all (λx. x < Suc nmax) ls"
  then have " x. ls = [x]"
    apply (case_tac "ls::nat list") by auto
  then obtain x where ls1: "ls = [x]" by auto
  with 0 have "x < Suc nmax" by auto
  with ls1 show ?case apply (simp add: enumBase_def) by auto
next
  case (Suc n)
  define ls' where "ls' = butlast ls"
  define l where "l = last ls"
  define ll where "ll = last ls'"
  define bl where "bl = butlast ls'"
  define ls'list where "ls'list = (enumAppend nmax ^^ n) (enumBase nmax)"
  then have short: "(enumAppend nmax ^^ n) (enumBase nmax) = ls'list" by simp
  from Suc have "ls  []" by auto
  then have "ls = butlast ls @ [last ls]" by auto
  with ls'_def l_def have ls1: "ls = ls' @ [l]" by auto
  with Suc have "length ls' = Suc n" by auto
  then have ls'ne: "ls'  []" by auto
  with ll_def bl_def have ls'1: "ls' = bl @ [ll]" by auto
  then have ll_in_ls': "ll  set ls'" by simp
  from Suc ls1 have "list_all (λx. x < Suc nmax) ls'" by auto
  with ll_in_ls' have "ll < Suc nmax" by (induct ls') auto
  with ll_def have llsmall: "last ls'  nmax"  by auto

  from ls1 have l_in_ls: "l  set ls" by auto
  from Suc have "list_all (λx. x < Suc nmax) ls" by auto
  with l_in_ls have "l < Suc nmax" by (induct ls) auto
  then have lo: "l  nmax" by auto

  from Suc ls1 ls'1 have "increasing ((bl @ [ll]) @ [l])" by auto
  then have "ll   l" by (rule increasing2) auto
  with ll_def have lu: "last ls'  l" by simp

  from Suc ls1 have vors: "ls'  set ((enumAppend nmax ^^ n) (enumBase nmax))"
    by (rule_tac Suc) (auto intro: increasing4)
  with short have "ls'  set ls'list"  by  auto
  with short llsmall ls1 lo lu show ?case  apply simp  apply (simp add: enumAppend_def)
    apply (intro bexI) by auto
qed

lemma enumerator_completeness: "2 < m  incrIndexList ls m nmax 
  ls  set (enumerator m nmax)"
proof -
  assume m: "2 < m" and props: "incrIndexList ls m nmax"
  then have props': "(hd ls = 0  last ls = (nmax - 1)
    length ls = m  last (butlast ls) < last ls   increasing ls)"
   by (unfold incrIndexList_def) auto
  show ?thesis
  proof -
    have props'': "hd ls = 0  last ls = (nmax - 1)  length ls = m 
       increasing ls"
      by (auto simp: props')
    show "ls  set (enumerator m nmax)"
    proof -
      from m props'' have l_ls: "2 < length ls"  by auto
      then have " x y ks. ls = x # ks @ [y]"
        apply (case_tac "ls::(nat list)") apply auto
        apply (case_tac "list" rule: rev_exhaust) by auto
      then obtain x y ks where "ls = x # ks @ [y]" by auto
      with props'' have ls': "ls = 0 # ks @ [nmax - 1]" by auto
      with l_ls have l_ms: "0 < length ks" by auto
      then have ms_ne: "ks  []" by auto
      from ls' have lks: "length ks = length ls - 2" by auto
      from props'' have nd: "increasing ls" by auto
      from props'' have " z. z  set ks  0  z" by auto
      from props'' ls' have "increasing ((0 # ks) @ [nmax - 1])" by auto
      then have z: " z. z  set ks  z  (nmax - 1)"
        by (drule_tac increasing2) auto
      from props  ls' have z': " z. z  set ks  z  (nmax - 2)" by auto

      have "ks  set ((enumAppend (nmax - 2)
         ^^ (length ks - Suc 0)) (enumBase (nmax - 2)))"
      proof (cases "ks = []")   
        case True with ms_ne show ?thesis by simp
      next
        case False
        from props'' have "increasing ls" by auto
        with ls' have "increasing (0 # ks)" by (auto intro: increasing4)
        then have "increasing ([0] @ ks)" by auto
        then have ndks: "increasing ks" by (rule_tac increasing5)
        have listall: "list_all (λx. x < Suc (nmax - 2)) ks"
          apply (simp add: list_all_iff)
          by (auto dest: z')
        with False ndks show ?thesis
          apply (rule_tac enumerator_completeness_help) by auto
      qed
      with lks props' have
        "ks  set ((enumAppend (nmax - 2) ^^ (m - 3)) (enumBase (nmax - 2)))" by auto
      with m ls' show ?thesis by (simp add: enumerator_def)
    qed
  qed
qed

lemma enumerator_equiv[simp]:
 "2 < n  1 < m  is  set(enumerator n m) = incrIndexList is n m"
by (auto intro: enumerator_correctness enumerator_completeness)


end

Theory FaceDivisionProps

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section‹Properties of Face Division›

theory FaceDivisionProps
imports Plane EnumeratorProps
begin

subsection‹Finality›

(********************* makeFaceFinal ****************************)

lemma vertices_makeFaceFinal: "vertices(makeFaceFinal f g) = vertices g"
by(induct g)(simp add:vertices_graph_def makeFaceFinal_def)

lemma edges_makeFaceFinal: " (makeFaceFinal f g) =  g"
proof -
  { fix fs
    have "(fset (makeFaceFinalFaceList f fs) edges f) = (f set fs edges f)"
    apply(unfold makeFaceFinalFaceList_def)
    apply(induct f)
    by(induct fs) simp_all }
  thus ?thesis by(simp add:edges_graph_def makeFaceFinal_def)
qed


lemma in_set_repl_setFin:
  "f  set fs  final f  f  set (replace f' [setFinal f'] fs)"
by (induct fs) auto

lemma in_set_repl:  "f  set fs  f  f'  f  set (replace f' fs' fs)"
by (induct fs) auto

lemma makeFaceFinals_preserve_finals:
  "f  set (finals g)  f  set (finals (makeFaceFinal f' g))"
by (induct g)
   (simp add:makeFaceFinal_def finals_def makeFaceFinalFaceList_def
             in_set_repl_setFin)


lemma len_faces_makeFaceFinal[simp]:
 "|faces (makeFaceFinal f g)| = |faces g|"
by(simp add:makeFaceFinal_def makeFaceFinalFaceList_def)

lemma len_finals_makeFaceFinal:
 "f   g  ¬ final f  |finals (makeFaceFinal f g)| = |finals g| + 1"
by(simp add:makeFaceFinal_def finals_def makeFaceFinalFaceList_def
            length_filter_replace1)

lemma len_nonFinals_makeFaceFinal:
 " ¬ final f; f   g
   |nonFinals (makeFaceFinal f g)| = |nonFinals g| - 1"
by(simp add:makeFaceFinal_def nonFinals_def makeFaceFinalFaceList_def
            length_filter_replace2)


lemma set_finals_makeFaceFinal[simp]: "distinct(faces g)  f   g 
  set(finals (makeFaceFinal f g)) = insert (setFinal f) (set(finals g))"
by(auto simp:finals_def makeFaceFinal_def makeFaceFinalFaceList_def
                distinct_set_replace)


lemma splitFace_preserve_final:
  "f  set (finals g)  ¬ final f' 
   f  set (finals (snd (snd (splitFace g i j f' ns))))"
  by (induct g) (auto simp add: splitFace_def finals_def split_def
                      intro: in_set_repl)

lemma splitFace_nonFinal_face:
  "¬ final (fst (snd (splitFace g i j f' ns)))"
  by (simp add: splitFace_def split_def split_face_def)


lemma subdivFace'_preserve_finals:
  "n i f' g. f  set (finals g)   ¬ final f' 
   f  set (finals (subdivFace' g f' i n is))"
proof (induct "is")
  case Nil then show ?case by(simp add:makeFaceFinals_preserve_finals)
next
  case (Cons j "js") then show ?case
  proof (cases j)
    case None with Cons show ?thesis by simp
  next
    case (Some sj)
    with Cons show ?thesis
      by (auto simp: splitFace_preserve_final splitFace_nonFinal_face split_def)
  qed
qed

lemma subdivFace_pres_finals:
  "f  set (finals g)  ¬ final f' 
   f  set (finals (subdivFace g f' is))"
by(simp add:subdivFace_def subdivFace'_preserve_finals)


declare Nat.diff_is_0_eq' [simp del]

(********************* section is_prefix ****************************)
subsection is_prefix›

definition is_prefix :: "'a list  'a list  bool" where
"is_prefix ls vs   ( bs. vs = ls @ bs)"

lemma is_prefix_add:
  "is_prefix ls vs  is_prefix (as @ ls) (as @ vs)" by (simp add: is_prefix_def)

lemma is_prefix_hd[simp]:
  "is_prefix [l] vs = (l = hd vs  vs  [])"
  apply (rule iffI) apply (auto simp: is_prefix_def)
  apply (intro exI) apply (subgoal_tac "vs = hd vs # tl vs") apply assumption by auto

lemma is_prefix_f[simp]:
  "is_prefix (a#as) (a#vs) = is_prefix as vs" by (auto simp: is_prefix_def)

lemma splitAt_is_prefix: "ram  set vs  is_prefix (fst (splitAt ram vs) @ [ram]) vs"
by (auto dest!: splitAt_ram simp: is_prefix_def)


(******************** section is_sublist *********************************)
subsection is_sublist›

definition is_sublist :: "'a list  'a list  bool" where
"is_sublist ls vs   ( as bs. vs = as @ ls @ bs)"

lemma is_prefix_sublist:
  "is_prefix ls vs  is_sublist ls vs" by (auto simp: is_prefix_def is_sublist_def)

lemma is_sublist_trans: "is_sublist as bs  is_sublist bs cs  is_sublist as cs"
  apply (simp add: is_sublist_def) apply (elim exE)
  apply (subgoal_tac "cs = (asaa @ asa) @ as @ (bsa @ bsaa)")
  apply (intro exI)  apply assumption by force

lemma is_sublist_add: "is_sublist as bs  is_sublist as (xs @ bs @ ys)"
  apply (simp add: is_sublist_def) apply (elim exE)
  apply (subgoal_tac "xs @ bs @ ys = (xs @ asa) @ as @ (bsa @ ys)")
  apply (intro exI) apply assumption by auto


lemma is_sublist_rec:
"is_sublist xs ys =
 (if length xs > length ys then False else
  if xs = take (length xs) ys then True else is_sublist xs (tl ys))"
proof (simp add:is_sublist_def, goal_cases)
  case 1 show ?case
  proof (standard, goal_cases)
    case 1 show ?case
    proof (standard, goal_cases)
      case xs: 1
      show ?case
      proof (standard, goal_cases)
        case 1 show ?case by auto
      next
        case 2 show ?case
        proof (standard, goal_cases)
          case 1
          have "ys = take |xs| ys @ drop |xs| ys" by simp
          also have " = [] @ xs @ drop |xs| ys" by(simp add:xs[symmetric])
          finally show ?case by blast
        qed
      qed
    qed
  next
    case 2 show ?case
    proof (standard, goal_cases)
      case xs_neq: 1
      show ?case
      proof (standard, goal_cases)
        case 1 show ?case by auto
      next
        case 2 show ?case
        proof (standard, goal_cases)
          case not_less: 1 show ?case
          proof (standard, goal_cases)
            case 1
            then obtain as bs where ys: "ys = as @ xs @ bs" by blast
            have "as  []" using xs_neq ys by auto
            then obtain a as' where "as = a # as'"
              by (simp add:neq_Nil_conv) blast
            hence "tl ys = as' @ xs @ bs" by(simp add:ys)
            thus ?case by blast
          next
            case 2
            then obtain as bs where ys: "tl ys = as @ xs @ bs" by blast
            have "ys  []" using xs_neq not_less by auto
            then obtain y ys' where "ys = y # ys'"
              by (simp add:neq_Nil_conv) blast
            hence "ys = (y#as) @ xs @ bs" using ys by simp
            thus ?case by blast
          qed
        qed
      qed
    qed
  qed
qed


lemma not_sublist_len[simp]:
 "|ys| < |xs|  ¬ is_sublist xs ys"
by(simp add:is_sublist_rec)

lemma is_sublist_simp[simp]: "a  v  is_sublist (a#as) (v#vs) = is_sublist (a#as) vs"
proof
  assume av: "a  v" and subl: "is_sublist (a # as) (v # vs)"
  then obtain rs ts where vvs: "v#vs = rs @ (a # as) @ ts" by (auto simp: is_sublist_def)
  with av have "rs  []" by auto
  with vvs have "tl (v#vs) = tl rs @ a # as @ ts" by auto
  then have "vs = tl rs @ a # as @ ts" by auto
  then show "is_sublist (a # as) vs" by (auto simp: is_sublist_def)
next
  assume av: "a  v" and subl: "is_sublist (a # as) vs"
  then show "is_sublist (a # as) (v # vs)" apply (auto simp: is_sublist_def)  apply (intro exI)
    apply (subgoal_tac "v # asa @ a # as @ bs = (v # asa) @ a # as @ bs") apply assumption by auto
qed

lemma is_sublist_id[simp]: "is_sublist vs vs" apply (auto simp: is_sublist_def) apply (intro exI)
  apply (subgoal_tac "vs = [] @ vs @ []") by (assumption) auto

lemma is_sublist_in: "is_sublist (a#as) vs  a  set vs" by (auto simp: is_sublist_def)

lemma is_sublist_in1: "is_sublist [x,y] vs  y  set vs" by (auto simp: is_sublist_def)

lemma is_sublist_notlast[simp]: "distinct vs  x = last vs  ¬ is_sublist [x,y] vs"
proof
  assume dvs: "distinct vs" and xl: "x = last vs" and subl:"is_sublist [x, y] vs"
  then obtain rs ts where vs: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
  define as where "as = rs @ [x]"
  define bs where "bs = y # ts"
  then have bsne: "bs  []" by auto
  from as_def bs_def have vs2: "vs = as @ bs" using vs by auto
  with as_def have xas: "x  set as" by auto
  from bsne vs2 have "last vs = last bs" by auto
  with xl have "x = last bs" by auto
  with bsne have "bs = (butlast bs) @ [x]" by auto
  then have "x  set bs" by (induct bs) auto
  with xas vs2 dvs show False by auto
qed

lemma is_sublist_nth1: "is_sublist [x,y] ls 
   i j. i < length ls  j < length ls  ls!i = x  ls!j = y  Suc i = j"
proof -
  assume subl: "is_sublist [x,y] ls"
  then obtain as bs where "ls = as @ x # y # bs" by (auto simp: is_sublist_def)
  then have "(length as) < length ls  (Suc (length as)) < length ls  ls!(length as) = x
        ls!(Suc (length as)) = y  Suc (length as) = (Suc (length as))"
    apply auto apply hypsubst_thin apply (induct as) by auto
  then show ?thesis by auto
qed

lemma is_sublist_nth2: " i j. i < length ls  j < length ls  ls!i = x  ls!j = y  Suc i = j 
 is_sublist [x,y] ls "
proof -
  assume " i j. i < length ls  j < length ls  ls!i = x  ls!j = y  Suc i = j"
  then obtain i j where vors: "i < length ls  j < length ls  ls!i = x  ls!j = y  Suc i = j" by auto
  then have "ls = take (Suc (Suc i)) ls @ drop (Suc (Suc i)) ls" by auto
  with vors have "ls = take (Suc i) ls @ [ls! (Suc i)] @ drop (Suc (Suc i)) ls"
    by (auto simp: take_Suc_conv_app_nth)
  with vors have "ls = take i ls @ [ls!i] @ [ls! (Suc i)] @ drop (Suc (Suc i)) ls"
   by (auto simp: take_Suc_conv_app_nth)
  with vors show ?thesis by (auto simp: is_sublist_def)
qed

lemma is_sublist_tl: "is_sublist (a # as) vs  is_sublist as vs" apply (simp add: is_sublist_def)
  apply (elim exE) apply (intro exI)
  apply (subgoal_tac "vs = (asa @ [a]) @ as @ bs") apply assumption by auto

lemma is_sublist_hd: "is_sublist (a # as) vs  is_sublist [a] vs" apply (simp add: is_sublist_def) by auto

lemma is_sublist_hd_eq[simp]: "(is_sublist [a] vs) = (a  set vs)" apply (rule_tac iffI)
  apply (simp add: is_sublist_def) apply force
  apply (simp add: is_sublist_def) apply (induct vs) apply force apply (case_tac "a = aa") apply force
  apply (subgoal_tac "a  set vs") apply simp apply (elim exE) apply (intro exI)
  apply (subgoal_tac "aa # vs = (aa # as) @ a # bs") apply (assumption) by auto

lemma is_sublist_distinct_prefix:
  "is_sublist (v#as) (v # vs)  distinct (v # vs)  is_prefix as vs"
proof -
  assume d:  "distinct (v # vs)" and subl: "is_sublist (v # as) (v # vs)"
  from subl obtain rs ts where v_vs: "v # vs = rs @ (v # as) @ ts" by (simp add: is_sublist_def) auto
  from d have v: "v  set vs" by auto
  then have "¬ is_sublist (v # as) vs" by (auto dest: is_sublist_hd)
  with v_vs have "rs = []" apply (cases rs) by (auto simp: is_sublist_def)
  with v_vs show "is_prefix as vs" by (auto simp: is_prefix_def)
qed

lemma is_sublist_distinct[intro]:
  "is_sublist as vs  distinct vs  distinct as" by (auto simp: is_sublist_def)

lemma is_sublist_y_hd: "distinct vs  y = hd vs  ¬ is_sublist [x,y] vs"
proof
  assume d: "distinct vs" and yh: "y = hd vs" and subl: "is_sublist [x, y] vs"
  then obtain rs ts where vs: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
  define as where "as = rs @ [x]"
  then have asne: "as  []" by auto
  define bs where "bs = y # ts"
  then have bsne: "bs  []" by auto
  from as_def bs_def have vs2: "vs = as @ bs" using vs by auto
  from bs_def have xbs: "y  set bs" by auto
  from vs2 asne have "hd vs = hd as" by simp
  with yh have "y = hd as" by auto
  with asne have "y  set as" by (induct as) auto
  with d xbs vs2 show False by auto
qed

lemma is_sublist_at1: "distinct (as @ bs)  is_sublist [x,y] (as @ bs)  x  (last as)  
  is_sublist [x,y] as  is_sublist [x,y] bs"
proof (cases "x  set as")
  assume d: "distinct (as @ bs)"  and subl: "is_sublist [x, y] (as @ bs)" and xnl: "x  last as"
  define vs where "vs = as @ bs"
  with d have dvs: "distinct vs" by auto
  case True
  with xnl subl have ind: "is_sublist (as@bs) vs  is_sublist [x, y] as"
  proof (induct as)
    case Nil
    then show ?case by force
  next
    case (Cons a as)
    assume ih: "is_sublist (as@bs) vs; x  last as; is_sublist [x,y] (as @ bs); x  set as 
      is_sublist [x, y] as" and subl_aas_vs: "is_sublist ((a # as) @ bs) vs"
      and xnl2: "x  last (a # as)" and subl2: "is_sublist [x, y] ((a # as) @ bs)"
      and x: "x  set (a # as)"
    then have rule1: "x  a  is_sublist [x,y] as" apply (cases "as = []") apply simp
      apply (rule_tac ih) by (auto dest: is_sublist_tl)

    from dvs subl_aas_vs have daas: "distinct (a # as @ bs)" apply (rule_tac is_sublist_distinct) by auto
    from xnl2 have asne: "x = a  as  []" by auto
    with subl2 daas have yhdas: "x = a  y = hd as" apply simp apply (drule_tac is_sublist_distinct_prefix) by auto
    with asne have "x = a  as = y # tl as" by auto
    with asne yhdas have "x = a  is_prefix [x,y] (a # as)" by auto
    then have rule2: "x = a  is_sublist [x,y] (a # as)" by (simp add: is_prefix_sublist)

    from rule1 rule2 show ?case by (cases "x = a") auto
  qed
  from vs_def d have "is_sublist [x, y] as" by (rule_tac ind) auto
  then show ?thesis by auto
next
  assume d: "distinct (as @ bs)"  and subl: "is_sublist [x, y] (as @ bs)" and xnl: "x  last as"
  define ars where "ars = as"
  case False
  with ars_def have xars: "x  set ars" by auto
  from subl have ind: "is_sublist as ars  is_sublist [x, y] bs"
  proof (induct as)
    case Nil
    then show ?case by auto
  next
    case (Cons a as)
    assume ih: "is_sublist as ars; is_sublist [x, y] (as @ bs)  is_sublist [x, y] bs"
      and subl_aasbsvs: "is_sublist (a # as) ars" and subl2: "is_sublist [x, y] ((a # as) @ bs)"
    from subl_aasbsvs ars_def False have "x  a" by (auto simp:is_sublist_in)
    with subl_aasbsvs subl2 show ?thesis apply (rule_tac ih) by (auto dest: is_sublist_tl)
  qed
  from ars_def have "is_sublist [x, y] bs" by (rule_tac ind) auto
  then show ?thesis by auto
qed

lemma is_sublist_at4: "distinct (as @ bs)  is_sublist [x,y] (as @ bs) 
  as  []  x = last as  y = hd bs"
proof -
  assume d: "distinct (as @ bs)" and subl: "is_sublist [x,y] (as @ bs)"
    and asne: "as  []" and xl: "x = last as"
  define vs where "vs = as @ bs"
  with subl have "is_sublist [x,y] vs" by auto
  then obtain rs ts where vs2: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
  from vs_def d have dvs:"distinct vs" by auto
  from asne xl have as:"as = butlast as @ [x]" by auto
  with vs_def have vs3: "vs = butlast as @ x # bs" by auto
  from dvs vs2 vs3 have "rs = butlast as" apply (rule_tac dist_at1) by auto
  then have "rs @ [x] = butlast as @ [x]" by auto
  with as have "rs @ [x] = as" by auto
  then have "as = rs @ [x]" by auto
  with vs2 vs_def have "bs = y # ts" by auto
  then show ?thesis by auto
qed

lemma is_sublist_at5: "distinct (as @ bs)  is_sublist [x,y] (as @ bs) 
  is_sublist [x,y] as  is_sublist [x,y] bs  x = last as  y = hd bs"
  apply (case_tac "as = []") apply simp apply (cases "x = last as")
  apply (subgoal_tac "y = hd bs") apply simp
  apply (rule is_sublist_at4) apply assumption+  (*apply force+ *)
  apply (drule_tac is_sublist_at1) by auto

lemma is_sublist_rev: "is_sublist [a,b] (rev zs) = is_sublist [b,a] zs"
  apply (simp add: is_sublist_def)
    apply (intro iffI) apply (elim exE) apply (intro exI)
    apply (subgoal_tac "zs = (rev bs) @ b # a # rev as") apply assumption
    apply (subgoal_tac "rev (rev zs) = rev (as @ a # b # bs)")
      apply (thin_tac "rev zs = as @ a # b # bs") apply simp
      apply simp
    apply (elim exE) apply (intro exI) by force

lemma is_sublist_at5'[simp]:
 "distinct as  distinct bs  set as  set bs = {}  is_sublist [x,y] (as @ bs) 
 is_sublist [x,y] as  is_sublist [x,y] bs  x = last as  y = hd bs"
apply (subgoal_tac "distinct (as @ bs)") apply (drule is_sublist_at5) by auto

lemma splitAt_is_sublist1R[simp]: "ram  set vs  is_sublist (fst (splitAt ram vs) @ [ram]) vs"
apply (auto dest!: splitAt_ram simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "vs = [] @ fst (splitAt ram vs) @ ram # snd (splitAt ram vs)") apply assumption by simp

lemma splitAt_is_sublist2R[simp]: "ram  set vs  is_sublist (ram # snd (splitAt ram vs)) vs"
apply (auto dest!: splitAt_ram splitAt_no_ram simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs) @ []") apply assumption by auto



(*********************** section is_nextElem *****************************)
subsection is_nextElem›

definition is_nextElem :: "'a list  'a  'a  bool" where
 "is_nextElem xs x y  is_sublist [x,y] xs  xs  []  x = last xs  y = hd xs"

lemma is_nextElem_a[intro]: "is_nextElem vs a b  a  set vs"
  by (auto simp: is_nextElem_def is_sublist_def)
lemma is_nextElem_b[intro]: "is_nextElem vs a b  b  set vs"
  by (auto simp: is_nextElem_def is_sublist_def)
lemma is_nextElem_last_hd[intro]: "distinct vs  is_nextElem vs x y 
  x = last vs  y = hd vs"
  by (auto simp: is_nextElem_def)
lemma is_nextElem_last_ne[intro]: "distinct vs  is_nextElem vs x y 
  x = last vs  vs  []"
  by (auto simp: is_nextElem_def)
lemma is_nextElem_sublistI: "is_sublist [x,y] vs  is_nextElem vs x y"
  by (auto simp: is_nextElem_def)

lemma is_nextElem_nth1: "is_nextElem ls x y   i j. i < length ls
   j < length ls  ls!i = x  ls!j = y  (Suc i) mod (length ls) = j"
proof (cases "is_sublist [x,y] ls")
  assume is_nextElem: "is_nextElem ls x y"
  case True then show ?thesis apply (drule_tac is_sublist_nth1) by auto
next
  assume is_nextElem: "is_nextElem ls x y"
  case False with is_nextElem have hl: "ls  []  last ls = x  hd ls = y"
    by (auto simp: is_nextElem_def)
  then have j: "ls!0 = y" by (cases ls) auto
  from hl have i: "ls!(length ls - 1) = x" by (cases ls rule: rev_exhaust)  auto
  from i j hl have "(length ls - 1) < length ls  0 < length ls  ls!(length ls - 1) = x
     ls!0 = y  (Suc (length ls - 1)) mod (length ls) = 0" by auto
  then show ?thesis apply (intro exI) .
qed

lemma is_nextElem_nth2: "  i j. i < length ls  j < length ls  ls!i = x  ls!j = y
    (Suc i) mod (length ls) = j  is_nextElem ls x y"
proof -
  assume " i j. i < length ls  j < length ls  ls!i = x  ls!j = y  (Suc i) mod (length ls) = j"
  then obtain i j where vors: "i < length ls  j < length ls  ls!i = x  ls!j = y
     (Suc i) mod (length ls) = j" by auto
  then show ?thesis
  proof (cases "Suc i = length ls")
    case True with vors have "j = 0" by auto
      (*ls ! i = last ls*)
    with True vors show ?thesis apply (auto simp: is_nextElem_def)
     apply (cases ls rule: rev_exhaust) apply auto apply (cases ls) by auto
  next
    case False with vors have "is_sublist [x,y] ls"
    apply (rule_tac is_sublist_nth2) by auto
    then show ?thesis by (simp add: is_nextElem_def)
  qed
qed

lemma is_nextElem_rotate1_aux:
  "is_nextElem (rotate m ls) x y  is_nextElem ls x y"
proof -
  assume is_nextElem: "is_nextElem (rotate m ls) x y"
  define n where "n = m mod length ls"
  then have rot_eq: "rotate m ls = rotate n ls"
    by (auto intro: rotate_conv_mod)
  with is_nextElem have "is_nextElem (rotate n ls) x y"
    by simp
  then obtain i j where vors:"i < length (rotate n ls)  j < length (rotate n ls) 
    (rotate n ls)!i = x  (rotate n ls)!j = y 
    (Suc i) mod (length (rotate n ls)) = j"
    by (drule_tac is_nextElem_nth1) auto
  then have lls: "0 < length ls"
    by auto
  define k where "k = (i+n) mod (length ls)"
  with lls have sk: "k < length ls"
    by simp
  from k_def lls vors have "ls!k = (rotate n ls)!(i mod (length ls))"
    by (simp add: nth_rotate)
  with vors have lsk: "ls!k = x"
    by simp
  define l where "l = (j+n) mod (length ls)"
  with lls have sl: "l < length ls"
    by simp
  from l_def lls vors have "ls!l = (rotate n ls)!(j mod (length ls))"
    by (simp add: nth_rotate)
  with vors have lsl: "ls!l = y"
    by simp
  from vors k_def l_def
  have "(Suc i) mod length ls = j"
    by simp
  then have "(Suc i) mod length ls = j mod length ls"
    by auto
  then have "((Suc i) mod length ls + n mod (length ls)) mod length ls
    = (j mod length ls + n mod (length ls)) mod length ls"
    by simp
  then have "((Suc i) + n) mod length ls = (j + n) mod length ls"
    by (simp add: mod_simps)
  with vors k_def l_def have "(Suc k) mod (length ls) = l"
    by (simp add: mod_simps)
  with sk lsk sl lsl
  show ?thesis
    by (auto intro: is_nextElem_nth2)
qed

lemma is_nextElem_rotate_eq[simp]: "is_nextElem (rotate m ls) x y = is_nextElem ls x y"
  apply (auto dest: is_nextElem_rotate1_aux) apply (rule is_nextElem_rotate1_aux)
  apply (subgoal_tac   "is_nextElem (rotate (length ls - m mod length ls) (rotate m ls)) x y")
  apply assumption by simp

lemma is_nextElem_congs_eq: "ls  ms  is_nextElem ls x y = is_nextElem ms x y"
by (auto simp: congs_def)

lemma is_nextElem_rev[simp]: "is_nextElem (rev zs) a b = is_nextElem zs b a"
  apply (simp add: is_nextElem_def is_sublist_rev)
  apply (case_tac "zs = []") apply simp apply simp
  apply (case_tac "a = hd zs") apply (case_tac "zs")  apply simp  apply simp apply simp
  apply (case_tac "a = last (rev zs)  b = last zs") apply simp
    apply (case_tac "zs" rule: rev_exhaust) apply simp
    apply (case_tac "ys") apply simp apply simp by force


lemma is_nextElem_circ:
  " distinct xs; is_nextElem xs a b; is_nextElem xs b a   |xs|  2"
apply(drule is_nextElem_nth1)
apply(drule is_nextElem_nth1)
apply (clarsimp)
apply(rename_tac i j)
apply(frule_tac i=j and j = "Suc i mod |xs|" in nth_eq_iff_index_eq)
  apply assumption+
apply(frule_tac j=i and i = "Suc j mod |xs|" in nth_eq_iff_index_eq)
  apply assumption+
apply(rule ccontr)
apply(simp add: distinct_conv_nth mod_Suc)
done


subsectionnextElem, sublist, is_nextElem›

lemma is_sublist_eq: "distinct vs  c  y 
 (nextElem vs c x = y) = is_sublist [x,y] vs"
proof -
  assume d: "distinct vs" and c: "c  y"
  have r1: "nextElem vs c x = y  is_sublist [x,y] vs"
  proof -
    assume fn: "nextElem vs c x = y"
    with c show ?thesis by(drule_tac nextElem_cases)(auto simp: is_sublist_def)
  qed
  with d have r2: "is_sublist [x,y] vs  nextElem vs c x = y"
  apply (simp add: is_sublist_def) apply (elim exE) by auto
  show ?thesis apply (intro iffI r1) by (auto intro: r2)
qed

lemma is_nextElem1: "distinct vs  x  set vs  nextElem vs (hd vs) x = y  is_nextElem vs x y"
proof -
  assume d: "distinct vs" and x: "x  set vs" and fn: "nextElem vs (hd vs) x = y"
  from x have r0: "vs  []" by auto
  from d fn have r1: "x = last vs  y = hd vs" by (auto)
  from d fn have r3: "hd vs  y  ( a b. vs = a @ [x,y] @ b)" by (drule_tac nextElem_cases) auto

  from x obtain n where xn:"x = vs!n" and nl: "n < length vs" by (auto simp: in_set_conv_nth)
  define as where "as = take n vs"
  define bs where "bs = drop (Suc n) vs"
  from as_def bs_def xn nl have vs:"vs = as @ [x] @ bs" by (auto intro: id_take_nth_drop)
  then have r2: "x  last vs  y  hd vs"
  proof -
    assume notx: "x  last vs"
    from vs notx have "bs  []" by auto
    with vs have r2: "vs = as @ [x, hd bs] @ tl bs" by auto
    with d have ineq: "hd bs  hd vs" by (cases as) auto
    from d fn r2 have "y = hd bs" by auto
    with ineq show ?thesis by auto
  qed
  from r0 r1 r2 r3 show ?thesis apply (simp add:is_nextElem_def is_sublist_def)
   apply (cases "x = last vs") by auto
qed

lemma is_nextElem2: "distinct vs  x  set vs  is_nextElem vs x y  nextElem vs (hd vs) x = y"
proof -
  assume d: "distinct vs" and x: "x  set vs" and is_nextElem: "is_nextElem vs x y"
  then show ?thesis apply (simp add: is_nextElem_def) apply (cases "is_sublist [x,y] vs")
    apply (cases "y = hd vs")
    apply (simp add: is_sublist_def) apply (force dest: distinct_hd_not_cons)
    apply (subgoal_tac "hd vs  y")  apply (simp add: is_sublist_eq) by auto
qed

lemma nextElem_is_nextElem:
 "distinct xs  x  set xs 
   is_nextElem xs x y = (nextElem xs (hd xs) x = y)"
  by (auto intro!: is_nextElem1 is_nextElem2)

lemma nextElem_congs_eq: "xs  ys  distinct xs  x  set xs  
   nextElem xs (hd xs) x = nextElem ys (hd ys) x"
proof -
  assume eq: "xs  ys" and dist: "distinct xs" and x: "x  set xs"
  define y where "y = nextElem xs (hd xs) x"
  then have f1:"nextElem xs (hd xs) x = y" by auto
  with dist x have "is_nextElem xs x y" by (auto intro: is_nextElem1)
  with eq have "is_nextElem ys x y" by (simp add:is_nextElem_congs_eq)
  with eq dist x have f2:"nextElem ys (hd ys) x = y"
    by (auto simp: congs_distinct intro: is_nextElem2)
  from f1 f2 show ?thesis by auto
qed


lemma is_sublist_is_nextElem: "distinct vs  is_nextElem vs x y  is_sublist as vs  x  set as  x  last as  is_sublist [x,y] as"
proof -
  assume d: "distinct vs" and is_nextElem: "is_nextElem vs x y" and subl: "is_sublist as vs" and xin: "x  set as" and xnl: "x  last as"
  from xin have asne: "as  []" by auto
  with subl have vsne: "vs  []" by (auto simp: is_sublist_def)
  from subl obtain rs ts where vs: "vs = rs @ as @ ts"  apply (simp add: is_sublist_def) apply (elim exE) by auto
  with d xnl asne have "x  last vs"
  proof (cases "ts = []")
    case True
    with d xnl asne vs show ?thesis by force
  next
    define lastvs where "lastvs = last ts"
    case False
    with vs lastvs_def have vs2: "vs = rs @ as @ butlast ts @ [lastvs]" by auto
    with d have "lastvs  set as" by auto
    with xin have "lastvs  x" by auto
    with vs2 show ?thesis by auto
  qed
  with is_nextElem have subl_vs: "is_sublist [x,y] vs" by (auto simp: is_nextElem_def)
  from d xin vs have "¬ is_sublist [x] rs" by auto
  then have nrs: "¬ is_sublist [x,y] rs" by (auto dest: is_sublist_hd)
  from d xin vs have "¬ is_sublist [x] ts" by auto
  then have nts: "¬ is_sublist [x,y] ts" by (auto dest: is_sublist_hd)
  from d xin vs have xnrs: "x  set rs" by auto
  then have notrs: "¬ is_sublist [x,y] rs" by (auto simp:is_sublist_in)
  from xnrs have xnlrs: "rs  []  x  last rs" by (induct rs) auto
  from d xin vs have xnts: "x  set ts" by auto
  then have notts: "¬ is_sublist [x,y] ts"  by (auto simp:is_sublist_in)
  from d vs subl_vs have "is_sublist [x,y] rs  is_sublist [x,y] (as@ts)" apply (cases "rs = []") apply simp apply (rule_tac is_sublist_at1) by (auto intro!: xnlrs)
  with notrs have "is_sublist [x,y] (as@ts)" by auto
  with d vs xnl have "is_sublist [x,y] as  is_sublist [x,y] ts" apply (rule_tac is_sublist_at1) by auto
  with notts show "is_sublist [x,y] as"  by auto
qed


subsection before›

definition before :: "'a list  'a  'a  bool" where
"before vs ram1 ram2   a b c. vs = a @ ram1 # b @ ram2 # c"

lemma before_dist_fst_fst[simp]: "before vs ram1 ram2  distinct vs  fst (splitAt ram2 (fst (splitAt ram1 vs))) = fst (splitAt ram1 (fst (splitAt ram2 vs)))"
  apply (simp add: before_def) apply (elim exE)
  apply (drule splitAt_dist_ram_all) by (auto dest!: pairD)

lemma before_dist_fst_snd[simp]: "before vs ram1 ram2  distinct vs  fst (splitAt ram2 (snd (splitAt ram1 vs))) = snd (splitAt ram1 (fst (splitAt ram2 vs)))"
  apply (simp add: before_def) apply (elim exE)
  apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)

lemma before_dist_snd_fst[simp]: "before vs ram1 ram2  distinct vs  snd (splitAt ram2 (fst (splitAt ram1 vs))) = snd (splitAt ram1 (snd (splitAt ram2 vs)))"
  apply (simp add: before_def) apply (elim exE)
  apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)

lemma before_dist_snd_snd[simp]: "before vs ram1 ram2  distinct vs  snd (splitAt ram2 (snd (splitAt ram1 vs))) = fst (splitAt ram1 (snd (splitAt ram2 vs)))"
  apply (simp add: before_def) apply (elim exE)
  apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)

lemma before_dist_snd[simp]: "before vs ram1 ram2  distinct vs  fst (splitAt ram1 (snd (splitAt ram2 vs))) = snd (splitAt ram2 vs)"
  apply (simp add: before_def) apply (elim exE)
  apply (drule_tac splitAt_dist_ram_all)   by (auto dest!: pairD)

lemma before_dist_fst[simp]: "before vs ram1 ram2  distinct vs  fst (splitAt ram1 (fst (splitAt ram2 vs))) = fst (splitAt ram1 vs)"
  apply (simp add: before_def) apply (elim exE)
  apply (drule_tac splitAt_dist_ram_all)   by (auto dest!: pairD)

lemma before_or: "ram1  set vs  ram2  set vs  ram1  ram2  before vs ram1 ram2  before vs ram2 ram1"
proof -
  assume r1: "ram1  set vs" and r2: "ram2  set vs" and r12: "ram1  ram2"
  then show ?thesis
    proof (cases "ram2  set (snd (splitAt ram1 vs))")
      define a where "a = fst (splitAt ram1 vs)"
      define b where "b = fst (splitAt ram2 (snd (splitAt ram1 vs)))"
      define c where "c = snd (splitAt ram2 (snd (splitAt ram1 vs)))"
      case True with r1 a_def b_def c_def have "vs = a @ [ram1] @ b @ [ram2] @ c"
        by (auto dest!: splitAt_ram)
      then show ?thesis apply (simp add: before_def) by auto
    next
      define ab where "ab = fst (splitAt ram1 vs)"
      case False
      with r1 r2 r12 ab_def have r2': "ram2  set ab" by (auto intro: splitAt_ram3)
      define a where "a = fst (splitAt ram2 ab)"
      define b where "b = snd (splitAt ram2 ab)"
      define c where "c = snd (splitAt ram1 vs)"
      from r1 ab_def c_def have "vs = ab @ [ram1] @ c" by (auto dest!: splitAt_ram)
      with r2' a_def b_def have "vs = (a @ [ram2] @ b) @ [ram1] @ c" by (drule_tac splitAt_ram) simp
      then show ?thesis apply (simp add: before_def) apply (rule disjI2) by auto
    qed
  qed

lemma before_r1:
  "before vs r1 r2  r1  set vs" by (auto simp: before_def)

lemma before_r2:
  "before vs r1 r2  r2  set vs" by (auto simp: before_def)

lemma before_dist_r2:
  "distinct vs  before vs r1 r2  r2  set (snd (splitAt r1 vs))"
proof -
  assume d: "distinct vs" and b: "before vs r1 r2"
  from d b have ex1: "∃! s. (vs = (fst s) @ r1 # snd (s))" apply (drule_tac before_r1) apply (rule distinct_unique1)  by auto
  from d b ex1 show ?thesis apply (unfold before_def)
    proof (elim exE ex1E)
      fix a b c s
      assume vs: "vs = a @ r1 # b @ r2 # c" and "y. vs = fst y @ r1 # snd y  y = s"
      then have  " y. vs = fst y @ r1 # snd y  y = s" by (clarify, hypsubst_thin, auto)
      then have single: " y. vs = fst y @ r1 # snd y  y = s" by auto
      define bc where "bc = b @ r2 # c"
      with vs have vs2: "vs = a @ r1 # bc" by auto
      from bc_def have  r2: "r2  set bc" by auto
      define t where "t = (a,bc)"
      with vs2 have vs3: "vs = fst (t) @ r1 # snd (t)" by auto
      with single have ts: "t = s" by (rule_tac single) auto
      from b have "splitAt r1 vs = s" apply (drule_tac before_r1) apply (drule_tac splitAt_ram) by (rule single) auto
      with ts have "t = splitAt r1 vs" by simp
      with t_def have "bc = snd(splitAt r1 vs)" by simp
      with r2 show ?thesis by simp
    qed
  qed

lemma before_dist_not_r2[intro]:
  "distinct vs  before vs r1 r2  r2   set (fst (splitAt r1 vs))" apply (frule before_dist_r2) by (auto dest: splitAt_distinct_fst_snd)

lemma before_dist_r1:
  "distinct vs  before vs r1 r2  r1  set (fst (splitAt r2 vs))"
proof -
  assume d: "distinct vs" and b: "before vs r1 r2"
  from d b have ex1: "∃! s. (vs = (fst s) @ r2 # snd (s))" apply (drule_tac before_r2) apply (rule distinct_unique1)  by auto
  from d b ex1 show ?thesis apply (unfold before_def)
    proof (elim exE ex1E)
      fix a b c s
      assume vs: "vs = a @ r1 # b @ r2 # c" and "y. vs = fst y @ r2 # snd y  y = s"
      then have  " y. vs = fst y @ r2 # snd y  y = s" by (clarify, hypsubst_thin, auto)
      then have single: " y. vs = fst y @ r2 # snd y  y = s" by auto
      define ab where "ab = a @ r1 # b"
      with vs have vs2: "vs = ab @ r2 # c" by auto
      from ab_def have  r1: "r1  set ab" by auto
      define t where "t = (ab,c)"
      with vs2 have vs3: "vs = fst (t) @ r2 # snd (t)" by auto
      with single have ts: "t = s" by (rule_tac single) auto
      from b have "splitAt r2 vs = s" apply (drule_tac before_r2) apply (drule_tac splitAt_ram) by (rule single) auto
      with ts have "t = splitAt r2 vs" by simp
      with t_def have "ab = fst(splitAt r2 vs)" by simp
      with r1 show ?thesis by simp
    qed
  qed

lemma before_dist_not_r1[intro]:
  "distinct vs  before vs r1 r2  r1   set (snd (splitAt r2 vs))" apply (frule before_dist_r1) by (auto dest: splitAt_distinct_fst_snd)

lemma before_snd:
  "r2  set (snd (splitAt r1 vs))  before vs r1 r2"
proof -
  assume r2: "r2  set (snd (splitAt r1 vs))"
  from r2 have r1: "r1  set vs" apply (rule_tac ccontr) apply (drule splitAt_no_ram) by simp
  define a where "a = fst (splitAt r1 vs)"
  define bc where "bc = snd (splitAt r1 vs)"
  define b where "b = fst (splitAt r2 bc)"
  define c where "c = snd (splitAt r2 bc)"
  from r1 a_def bc_def have vs: "vs = a @ [r1] @ bc" by (auto dest: splitAt_ram)
  from r2 bc_def have r2: "r2  set bc" by simp
  with b_def c_def have "bc = b @ [r2] @ c" by (auto dest: splitAt_ram)
  with vs show ?thesis by (simp add: before_def) auto
qed

lemma before_fst:
"r2  set vs  r1  set (fst (splitAt r2 vs))  before vs r1 r2"
proof -
  assume r2: "r2  set vs" and r1: "r1  set (fst (splitAt r2 vs))"
  define ab where "ab = fst (splitAt r2 vs)"
  define c where "c = snd (splitAt r2 vs)"
  define a where "a = fst (splitAt r1 ab)"
  define b where "b = snd (splitAt r1 ab)"
  from r2 ab_def c_def have vs: "vs = ab @ [r2] @ c" by (auto dest: splitAt_ram)
  from r1 ab_def have r1: "r1  set ab" by simp
  with a_def b_def have "ab = a @ [r1] @ b" by (auto dest: splitAt_ram)
  with vs show ?thesis by (simp add: before_def) auto
qed

(* usefule simplifier rules *)
lemma before_dist_eq_fst:
"distinct vs  r2  set vs  r1  set (fst (splitAt r2 vs)) = before vs r1 r2"
  by (auto intro: before_fst before_dist_r1)

lemma before_dist_eq_snd:
"distinct vs  r2  set (snd (splitAt r1 vs)) = before vs r1 r2"
  by (auto intro: before_snd before_dist_r2)

lemma before_dist_not1:
  "distinct vs  before vs ram1 ram2  ¬ before vs ram2 ram1"
proof
   assume d: "distinct vs" and b1: "before vs ram2 ram1" and b2: "before vs ram1 ram2"
   from b2 have r1: "ram1  set vs" by (drule_tac before_r1)
   from d b1 have r2: "ram2  set (fst (splitAt ram1 vs))" by (rule before_dist_r1)
   from d b2 have r2':"ram2  set (snd (splitAt ram1 vs))" by (rule before_dist_r2)
   from d r1 r2 r2' show "False" by (drule_tac splitAt_distinct_fst_snd) auto
qed

lemma before_dist_not2:
  "distinct vs  ram1  set vs  ram2  set vs  ram1  ram2  ¬ (before vs ram1 ram2)  before vs ram2 ram1"
proof -
  assume "distinct vs" "ram1  set vs " "ram2  set vs" "ram1  ram2" "¬ before vs ram1 ram2"
  then show "before vs ram2 ram1" apply (frule_tac before_or) by auto
qed

lemma before_dist_eq:
  "distinct vs  ram1  set vs  ram2  set vs  ram1  ram2  ( ¬ (before vs ram1 ram2)) = before vs ram2 ram1"
  by (auto intro: before_dist_not2 dest: before_dist_not1)

lemma before_vs:
 "distinct vs  before vs ram1 ram2  vs = fst (splitAt ram1 vs) @ ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs)"
proof -
  assume d: "distinct vs" and b: "before vs ram1 ram2"
  define s where "s = snd (splitAt ram1 vs)"
  from b have  "ram1  set vs" by (auto simp: before_def)
  with s_def have vs: "vs = fst (splitAt ram1 vs) @ [ram1] @ s" by (auto dest: splitAt_ram)
  from d b s_def have "ram2  set s" by (auto intro: before_dist_r2)
  then have snd: "s = fst (splitAt ram2 s) @ [ram2] @  snd (splitAt ram2 s)"
    by (auto dest: splitAt_ram)
  with vs have "vs = fst (splitAt ram1 vs) @ [ram1] @ fst (splitAt ram2 s) @ [ram2] @  snd (splitAt ram2 s)" by auto
  with d b s_def show ?thesis by auto
qed




(************************ between lemmas *************************************)
subsection @{const between}

definition pre_between :: "'a list  'a  'a  bool" where
"pre_between vs ram1 ram2 
   distinct vs  ram1  set vs  ram2  set vs  ram1  ram2"

declare pre_between_def [simp]

lemma pre_between_dist[intro]:
  "pre_between vs ram1 ram2  distinct vs" by (auto simp: pre_between_def)

lemma pre_between_r1[intro]:
  "pre_between vs ram1 ram2  ram1  set vs" by auto

lemma pre_between_r2[intro]:
  "pre_between vs ram1 ram2  ram2  set vs" by auto

lemma pre_between_r12[intro]:
  "pre_between vs ram1 ram2  ram1  ram2" by auto

lemma pre_between_symI:
  "pre_between vs ram1 ram2  pre_between vs ram2 ram1" by auto

lemma pre_between_before[dest]:
  "pre_between vs ram1 ram2  before vs ram1 ram2  before vs ram2 ram1" by (rule_tac before_or) auto

lemma pre_between_rotate1[intro]:
  "pre_between vs ram1 ram2  pre_between (rotate1 vs) ram1 ram2" by auto

lemma pre_between_rotate[intro]:
  "pre_between vs ram1 ram2  pre_between (rotate n vs) ram1 ram2" by auto

lemma(*<*) before_xor: (*>*)
 "pre_between vs ram1 ram2  (¬ before vs ram1 ram2) = before vs ram2 ram1"
  by (simp add: before_dist_eq)

declare pre_between_def [simp del]

lemma between_simp1[simp]:
"before vs ram1 ram2  pre_between vs ram1 ram2 
between vs ram1 ram2 = fst (splitAt ram2 (snd (splitAt ram1 vs)))"
by (simp add: pre_between_def between_def split_def before_dist_eq_snd)


lemma between_simp2[simp]:
"before vs ram1 ram2  pre_between vs ram1 ram2 
  between vs ram2 ram1 = snd (splitAt ram2 vs) @  fst (splitAt ram1 vs)"
proof -
  assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2"
  from p b have b2: "¬ before vs ram2 ram1" apply (simp add: pre_between_def) by (auto dest: before_dist_not1)
  with p have "ram2  set (fst (splitAt ram1 vs))" by (simp add: pre_between_def before_dist_eq_fst)
  then have "fst (splitAt ram1 vs) = fst (splitAt ram2 (fst (splitAt ram1 vs)))" by (auto dest: splitAt_no_ram)
  then have "fst (splitAt ram2 (fst (splitAt ram1 vs))) = fst (splitAt ram1 vs)" by auto
  with b2 b p show ?thesis apply (simp add: pre_between_def between_def split_def)
    by (auto dest: before_dist_not_r1)
qed

lemma between_not_r1[intro]:
  "distinct vs  ram1  set (between vs ram1 ram2)"
proof (cases "pre_between vs ram1 ram2")
  assume d: "distinct vs"
  case True then have p: "pre_between vs ram1 ram2" by auto
  then show "ram1  set (between vs ram1 ram2)"
  proof (cases "before vs ram1 ram2")
    case True with d p show ?thesis by (auto del: notI)
  next
    from p have p2: "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
    case False with p have "before vs ram2 ram1" by auto
    with d p2 show ?thesis  by (auto del: notI)
  qed
next
  assume d:"distinct vs"
  case False then have p: "¬ pre_between vs ram1 ram2" by auto
  then show ?thesis
  proof (cases "ram1 = ram2")
    case True with d have h1:"ram2  set (snd (splitAt ram2 vs))" by (auto del: notI)
    from True d have h2: "ram2  set (fst (splitAt ram2 (fst (splitAt ram2 vs))))" by (auto del: notI)
    with True d h1 show ?thesis by (auto simp: between_def split_def)
  next
    case False then have neq: "ram1  ram2" by auto
    then show ?thesis
    proof (cases "ram1  set vs")
      case True with d show ?thesis by (auto dest: splitAt_no_ram splitAt_in_fst simp: between_def split_def)
    next
      case False then have r1in: "ram1  set vs" by auto
      then show ?thesis
      proof (cases "ram2  set vs")
        from d have h1: "ram1  set (fst (splitAt ram1 vs))" by (auto del: notI)
        case True with d h1 show ?thesis
        by (auto dest: splitAt_not1 splitAt_in_fst splitAt_ram
        splitAt_no_ram simp: between_def split_def del: notI)
      next
        case False then have r2in: "ram2  set vs" by auto
        with d neq r1in have "pre_between vs ram1 ram2"
          by (auto simp: pre_between_def)
        with p show ?thesis by auto
      qed
    qed
  qed
qed

lemma between_not_r2[intro]:
  "distinct vs  ram2  set (between vs ram1 ram2)"
proof (cases "pre_between vs ram1 ram2")
  assume d: "distinct vs"
  case True then have p: "pre_between vs ram1 ram2" by auto
  then show "ram2  set (between vs ram1 ram2)"
  proof (cases "before vs ram1 ram2")
    from d have "ram2  set (fst (splitAt ram2 vs))" by (auto del: notI)
    then have h1: "ram2  set (snd (splitAt ram1 (fst (splitAt ram2 vs))))"
      by (auto dest: splitAt_in_fst)
    case True with d p h1 show ?thesis by (auto del: notI)
  next
    from p have p2: "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
    case False with p have "before vs ram2 ram1" by auto
    with d p2 show ?thesis  by (auto del: notI)
  qed
next
  assume d:"distinct vs"
  case False then have p: "¬ pre_between vs ram1 ram2" by auto
  then show ?thesis
  proof (cases "ram1 = ram2")
    case True with d have h1:"ram2  set (snd (splitAt ram2 vs))" by (auto del: notI)
    from True d have h2: "ram2  set (fst (splitAt ram2 (fst (splitAt ram2 vs))))" by (auto del: notI)
    with True d h1 show ?thesis by (auto simp: between_def split_def)
  next
    case False then have neq: "ram1  ram2" by auto
    then show ?thesis
    proof (cases "ram2  set vs")
      case True with d show ?thesis
        by (auto dest: splitAt_no_ram splitAt_in_fst
         splitAt_in_fst simp: between_def split_def)
    next
      case False then have r1in: "ram2  set vs" by auto
      then show ?thesis
      proof (cases "ram1  set vs")
        from d have h1: "ram1  set (fst (splitAt ram1 vs))" by (auto del: notI)
        case True with d h1 show ?thesis by  (auto dest: splitAt_ram splitAt_no_ram simp: between_def split_def del: notI)
      next
        case False then have r2in: "ram1  set vs" by auto
        with d neq r1in have "pre_between vs ram1 ram2" by (auto simp: pre_between_def)
        with p show ?thesis by auto
      qed
    qed
  qed
qed

lemma between_distinct[intro]:
  "distinct vs  distinct (between vs ram1 ram2)"
proof -
  assume vs: "distinct vs"
  define a where "a = fst (splitAt ram1 vs)"
  define b where "b = snd (splitAt ram1 vs)"
  from a_def b_def have ab: "(a,b) = splitAt ram1 vs" by auto
  with vs have ab_disj:"set a  set b = {}" by (drule_tac splitAt_distinct_ab)  auto
  define c where "c = fst (splitAt ram2 a)"
  define d where "d = snd (splitAt ram2 a)"
  from c_def d_def have c_d: "(c,d) = splitAt ram2 a" by auto
  with ab_disj have "set c  set b = {}" by (drule_tac splitAt_subset_ab) auto
  with vs a_def b_def c_def show ?thesis
    by (auto simp: between_def split_def splitAt_no_ram dest: splitAt_ram intro: splitAt_distinct_fst splitAt_distinct_snd)
qed

lemma between_distinct_r12:
  "distinct vs  ram1  ram2  distinct (ram1 # between vs ram1 ram2 @ [ram2])" by (auto del: notI)

lemma between_vs:
  "before vs ram1 ram2  pre_between vs ram1 ram2 
  vs = fst (splitAt ram1 vs) @ ram1 # (between vs ram1 ram2) @ ram2 # snd (splitAt ram2 vs)"
  apply (simp) apply (frule pre_between_dist) apply (drule before_vs) by auto

lemma between_in:
  "before vs ram1 ram2  pre_between vs ram1 ram2  x  set vs  x = ram1  x  set (between vs ram1 ram2)  x = ram2  x  set (between vs ram2 ram1)"
proof -
  assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2" and xin: "x  set vs"
  define a where "a = fst (splitAt ram1 vs)"
  define b where "b = between vs ram1 ram2"
  define c where "c = snd (splitAt ram2 vs)"
  from p have "distinct vs" by auto
  from p b a_def b_def c_def have "vs = a @ ram1 # b @ ram2 # c" apply (drule_tac between_vs)  by auto
  with xin have "x  set (a @ ram1 # b @ ram2 # c)" by auto
  then have "x  set (a)  x  set (ram1 #b)  x  set (ram2 # c)" by auto
  then have "x  set (a)  x = ram1  x  set b  x = ram2  x  set c" by auto
  then have "x  set c  x  set (a)  x = ram1  x  set b  x = ram2" by auto
  then have "x  set (c @ a)  x = ram1  x  set b  x = ram2" by auto
  with b p a_def b_def c_def show ?thesis by auto
qed

lemma
  "before vs ram1 ram2  pre_between vs ram1 ram2 
  hd vs  ram1  (a,b) = splitAt (hd vs) (between vs ram2 ram1) 
  vs = [hd vs] @ b @ [ram1] @ (between vs ram1 ram2) @ [ram2] @ a"
proof -
  assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2" and vs: "hd vs  ram1" and ab: "(a,b) = splitAt (hd vs) (between vs ram2 ram1)"
  from p have dist_b: "distinct (between vs ram2 ram1)" by (auto intro: between_distinct simp: pre_between_def)
  with ab have "distinct a  distinct b" by (auto intro: splitAt_distinct_a splitAt_distinct_b)
  define r where "r = snd (splitAt ram1 vs)"
  define btw where "btw = between vs ram2 ram1"
  from p r_def have vs2: "vs = fst (splitAt ram1 vs) @ [ram1] @ r" by (auto dest: splitAt_ram simp: pre_between_def)
  then have "fst (splitAt ram1 vs) = []  hd vs = ram1" by auto
  with vs have neq: "fst (splitAt ram1 vs)  []" by auto
  with vs2 have vs_fst: "hd vs = hd (fst (splitAt ram1 vs))" by (induct ("fst (splitAt ram1 vs)")) auto
  with neq have "hd vs  set (fst (splitAt ram1 vs))"  by auto
  with b p have "hd vs  set (between vs ram2 ram1)" by auto
  with btw_def have help1: "btw =  fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw)" by (auto dest: splitAt_ram)
  from p b btw_def have "btw = snd (splitAt ram2 vs) @  fst (splitAt ram1 vs)" by auto
  with neq have "btw = snd (splitAt ram2 vs) @ hd (fst (splitAt ram1 vs)) # tl (fst (splitAt ram1 vs))" by auto
  with vs_fst have "btw = snd (splitAt ram2 vs) @ [hd vs] @ tl (fst (splitAt ram1 vs))" by auto
  with help1 have eq: "snd (splitAt ram2 vs) @ [hd vs] @ tl (fst (splitAt ram1 vs)) = fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw)" by auto
  from dist_b btw_def help1 have "distinct (fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw))" by auto
  with eq have  eq2: "snd (splitAt ram2 vs) = fst (splitAt (hd vs) btw)  tl (fst (splitAt ram1 vs)) = snd (splitAt (hd vs) btw)" apply (rule_tac dist_at) by auto
  with btw_def ab have a: "a = snd (splitAt ram2 vs)" by (auto dest: pairD)
  from eq2 vs_fst have "hd (fst (splitAt ram1 vs)) # tl (fst (splitAt ram1 vs)) = hd vs # snd (splitAt (hd vs) btw)" by auto
  with ab btw_def neq have hdb: "hd vs # b = fst (splitAt ram1 vs)"  by (auto dest: pairD)

  from b p have "vs = fst (splitAt ram1 vs) @ [ram1] @ fst (splitAt ram2 (snd (splitAt ram1 vs))) @ [ram2] @ snd (splitAt ram2 vs)" apply simp
    apply (rule_tac before_vs) by (auto simp: pre_between_def)
  with hdb have "vs = (hd vs # b) @ [ram1] @ fst (splitAt ram2 (snd (splitAt ram1 vs))) @ [ram2] @ snd (splitAt ram2 vs)" by auto
  with a b p show ?thesis by (simp)
qed

lemma between_congs: "pre_between vs ram1 ram2  vs  vs'  between vs ram1 ram2 = between vs' ram1 ram2"
proof -
  have " us. pre_between us ram1 ram2  before us ram1 ram2  between us ram1 ram2 = between (rotate1 us) ram1 ram2"
  proof -
    fix us
    assume vors: "pre_between us ram1 ram2"  "before us ram1 ram2"
    then have pb2: "pre_between (rotate1 us) ram1 ram2" by auto
    with vors show "between us ram1 ram2 = between (rotate1 us) ram1 ram2"
    proof (cases "us")
      case Nil then show ?thesis by auto
    next
      case (Cons u' us')
      with vors pb2 show ?thesis apply (auto simp: before_def)
        apply (case_tac "a") apply auto
        by (simp_all add: between_def split_def pre_between_def)
    qed
  qed

  moreover have " us. pre_between us ram1 ram2  before us ram2 ram1  between us ram1 ram2 = between (rotate1 us) ram1 ram2"
  proof -
    fix us
    assume vors: " pre_between us ram1 ram2"  "before us ram2 ram1"
    then have pb2: "pre_between (rotate1 us) ram1 ram2" by auto
    with vors show "between us ram1 ram2 = between (rotate1 us) ram1 ram2"
    proof (cases "us")
      case Nil then show ?thesis by auto
    next
      case (Cons u' us')
      with vors pb2 show ?thesis apply (auto simp: before_def)
        apply (case_tac "a") apply auto
        by (simp_all add: between_def split_def pre_between_def)
    qed
  qed

  ultimately have "help": " us. pre_between us ram1 ram2  between us ram1 ram2 = between (rotate1 us) ram1 ram2"
    apply (subgoal_tac "before us ram1 ram2  before us ram2 ram1") by auto

  assume "vs  vs'" and pre_b: "pre_between vs ram1 ram2"
  then obtain n where vs': "vs' = rotate n vs" by (auto simp: congs_def)
  have "between vs ram1 ram2 = between (rotate n vs) ram1 ram2"
  proof (induct n)
    case 0 then show ?case by auto
  next
    case (Suc m) then show ?case apply simp
      apply (subgoal_tac " between (rotate1 (rotate m vs)) ram1 ram2 = between (rotate m vs) ram1 ram2")
      by (auto intro: "help" [symmetric] pre_b)
  qed
  with vs' show ?thesis by auto
qed

lemma between_inter_empty:
 "pre_between vs ram1 ram2 
  set (between vs ram1 ram2)  set (between vs ram2 ram1) = {}"
apply (case_tac "before vs ram1 ram2")
 apply (simp add: pre_between_def)
 apply (elim conjE)
 apply (frule (1) before_vs)
 apply (subgoal_tac "distinct (fst (splitAt ram1 vs) @
          ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs))")
  apply (thin_tac "vs = fst (splitAt ram1 vs) @
          ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs)")
  apply (frule (1) before_dist_fst_snd)
  apply(simp)
  apply blast
 apply (simp only:)
apply (simp add: before_xor)
apply (subgoal_tac "pre_between vs ram2 ram1")
 apply (simp add: pre_between_def)
 apply (elim conjE)
 apply (frule (1) before_vs)
 apply (subgoal_tac "distinct (fst (splitAt ram2 vs) @
          ram2 # fst (splitAt ram1 (snd (splitAt ram2 vs))) @ ram1 # snd (splitAt ram1 vs))")
  apply (thin_tac "vs = fst (splitAt ram2 vs) @
          ram2 # fst (splitAt ram1 (snd (splitAt ram2 vs))) @ ram1 # snd (splitAt ram1 vs)")
  apply simp
  apply blast
 apply (simp only:)
by (rule pre_between_symI)


(*********************** between - is_nextElem *************************)
subsubsection between is_nextElem›



lemma is_nextElem_or1: "pre_between vs ram1 ram2 
  is_nextElem vs x y  before vs ram1 ram2 
  is_sublist [x,y] (ram1 # between vs ram1 ram2 @ [ram2])
   is_sublist [x,y] (ram2 # between vs ram2 ram1 @ [ram1])"
proof -
  assume p: "pre_between vs ram1 ram2" and is_nextElem: "is_nextElem vs x y" and b: "before vs ram1 ram2"
  from p have r1: "ram1  set vs" by (auto simp: pre_between_def)
  define bs where "bs = [ram1] @ (between vs ram1 ram2) @ [ram2]"
  have rule1: "x  set (ram1 # (between vs ram1 ram2))  is_sublist [x,y] bs"
  proof -
    assume xin:"x  set (ram1 # (between vs ram1 ram2))"
    with bs_def have xin2: "x  set bs" by auto
    define s where "s = snd (splitAt ram1 vs)"
    from r1 s_def have sub1:"is_sublist (ram1 # s) vs" by (auto intro: splitAt_is_sublist2R)
    from b p s_def have "ram2  set s" by (auto intro!: before_dist_r2 simp: pre_between_def)
    then have "is_prefix (fst (splitAt ram2 s) @ [ram2]) s" by (auto intro!: splitAt_is_prefix)
    then have "is_prefix ([ram1] @ ((fst (splitAt ram2 s)) @ [ram2])) ([ram1] @ s)" by (rule_tac is_prefix_add) auto
    with sub1 have "is_sublist (ram1 # (fst (splitAt ram2 s)) @ [ram2]) vs" apply (rule_tac is_sublist_trans) apply (rule is_prefix_sublist)
      by simp_all
    with p b s_def bs_def have subl: "is_sublist bs vs" by (auto)
    with p have db: "distinct bs" by (auto simp: pre_between_def)
    with xin bs_def have xnlb:"x  last bs" by auto
    with p is_nextElem subl xin2 show "is_sublist [x,y] bs" apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
  qed
  define bs2 where "bs2 = [ram2] @ (between vs ram2 ram1) @ [ram1]"
  have rule2: "x  set (ram2 # (between vs ram2 ram1))  is_sublist [x,y] bs2"
  proof -
    assume xin:"x  set (ram2 # (between vs ram2 ram1))"
    with bs2_def have xin2: "x  set bs2" by auto
    define cs1 where "cs1 = ram2 # snd (splitAt ram2 vs)"
    then have cs1ne: "cs1  []" by auto
    define cs2 where "cs2 = fst (splitAt ram1 vs)"
    define cs2ram1 where "cs2ram1 = cs2 @ [ram1]"
    from cs1_def cs2_def bs2_def p b have bs2: "bs2 = cs1 @ cs2 @ [ram1]" by (auto simp: pre_between_def)
    have "x  set cs1  x  last cs1  is_sublist [x,y] cs1"
    proof-
      assume xin2: "x  set cs1" and xnlcs1: "x  last cs1"
      from cs1_def p have "is_sublist cs1 vs" by (simp add: pre_between_def)
      with p is_nextElem xnlcs1  xin2 show ?thesis  apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
    qed
    with bs2 have incs1nl: "x  set cs1  x  last cs1  is_sublist [x,y] bs2"
      apply (auto simp: is_sublist_def) apply (intro exI)
      apply (subgoal_tac "as @ x # y # bs @ cs2 @ [ram1] = as @ x # y # (bs @ cs2 @ [ram1])")
      apply assumption by auto
    have "x = last cs1  y = hd (cs2 @ [ram1])"
    proof -
      assume xl: "x = last cs1"
      from p have "distinct vs" by auto
      with p have "vs = fst (splitAt ram2 vs) @ ram2 # snd (splitAt ram2 vs)" by (auto intro: splitAt_ram)
      with cs1_def have "last vs = last (fst (splitAt ram2 vs) @ cs1)" by auto
      with cs1ne have "last vs = last cs1" by auto
      with xl have "x = last vs" by auto
      with p is_nextElem have yhd: "y = hd vs" by auto
      from p have "vs = fst (splitAt ram1 vs) @ ram1 # snd (splitAt ram1 vs)" by (auto intro: splitAt_ram)
      with yhd cs2ram1_def cs2_def have yhd2: "y = hd (cs2ram1 @ snd (splitAt ram1 vs))" by auto
      from cs2ram1_def have "cs2ram1  []" by auto
      then have "hd (cs2ram1 @ snd(splitAt ram1 vs)) = hd (cs2ram1)" by auto
      with yhd2 cs2ram1_def show ?thesis by auto
    qed
    with bs2 cs1ne have "x = last cs1  is_sublist [x,y] bs2"
      apply (auto simp: is_sublist_def) apply (intro exI)
      apply (subgoal_tac "cs1 @ cs2 @ [ram1] = butlast cs1 @ last cs1 # hd (cs2 @ [ram1]) # tl (cs2 @ [ram1])")
      apply assumption by auto
    with incs1nl have incs1: "x  set cs1  is_sublist [x,y] bs2" by auto
    have "x  set cs2  is_sublist [x,y] (cs2 @ [ram1])"
    proof-
      assume xin2': "x  set cs2"
      then have xin2: "x  set (cs2 @ [ram1])" by auto
      define fr2 where "fr2 = snd (splitAt ram1 vs)"
      from p have "vs = fst (splitAt ram1 vs) @ ram1 # snd (splitAt ram1 vs)" by (auto intro: splitAt_ram)
      with fr2_def cs2_def have "vs = cs2 @ [ram1] @ fr2" by simp
      with p xin2'  have "x  ram1" by (auto simp: pre_between_def)
      then have  xnlcs2: "x  last (cs2 @ [ram1])" by auto
      from cs2_def p have "is_sublist (cs2 @ [ram1]) vs" by (simp add: pre_between_def)
      with p is_nextElem xnlcs2  xin2 show ?thesis  apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
    qed
    with bs2 have "x  set cs2  is_sublist [x,y] bs2"
      apply (auto simp: is_sublist_def) apply (intro exI)
      apply (subgoal_tac "cs1 @ as @ x # y # bs = (cs1 @ as) @ x # y # bs")
      apply assumption by auto
    with p b cs1_def cs2_def incs1 xin show ?thesis by auto
  qed
  from is_nextElem have "x  set vs" by auto
  with b p have "x = ram1  x  set (between vs ram1 ram2)  x = ram2  x  set (between vs ram2 ram1)" by (rule_tac between_in) auto
  then have "x  set (ram1 # (between vs ram1 ram2))  x  set (ram2 # (between vs ram2 ram1))" by auto
  with rule1 rule2 bs_def bs2_def show ?thesis by auto
qed


lemma is_nextElem_or: "pre_between vs ram1 ram2  is_nextElem vs x y 
  is_sublist [x,y] (ram1 # between vs ram1 ram2 @ [ram2])   is_sublist [x,y] (ram2 # between vs ram2 ram1 @ [ram1])"
proof (cases "before vs ram1 ram2")
  case True
  assume "pre_between vs ram1 ram2" "is_nextElem vs x y"
  with True show ?thesis by (rule_tac is_nextElem_or1)
next
  assume p: "pre_between vs ram1 ram2" and is_nextElem: "is_nextElem vs x y"
  from p have p': "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
  case False with p have "before vs ram2 ram1" by auto
  with p' is_nextElem show ?thesis apply (drule_tac is_nextElem_or1) apply assumption+ by auto
qed


lemma(*<*) between_eq2: (*>*)
  "pre_between vs ram1 ram2 
  before vs ram2 ram1 
   as bs cs. between vs ram1 ram2 = cs @ as  vs = as @[ram2] @ bs @ [ram1] @ cs"
  apply (subgoal_tac "pre_between vs ram2 ram1")
  apply auto apply (intro exI conjI) apply simp  apply (simp add: pre_between_def) apply auto
  apply (frule_tac before_vs) apply auto by (auto simp: pre_between_def)

lemma is_sublist_same_len[simp]:
 "length xs = length ys  is_sublist xs ys = (xs = ys)"
apply(cases xs)
 apply simp
apply(rename_tac a as)
apply(cases ys)
 apply simp
apply(rename_tac b bs)
apply(case_tac "a = b")
 apply(subst is_sublist_rec)
 apply simp
apply simp
done


lemma is_nextElem_between_empty[simp]:
 "distinct vs  is_nextElem vs a b  between vs a b = []"
apply (simp add: is_nextElem_def between_def split_def)
apply (cases "vs") apply simp+
apply (simp split: if_split_asm)
apply (case_tac "b = aa")
 apply (simp add: is_sublist_def)
 apply (erule disjE)
  apply (elim exE)
  apply (case_tac "as")
   apply simp
  apply simp
 apply simp
 apply (case_tac "list" rule: rev_exhaust)
  apply simp
 apply simp
apply simp
apply (subgoal_tac "aa # list = vs")
 apply (thin_tac "vs = aa # list")
 apply simp
 apply (subgoal_tac "distinct vs")
  apply (simp add: is_sublist_def)
  apply (elim exE)
  by auto


lemma is_nextElem_between_empty': "between vs a b = []  distinct vs  a  set vs  b  set vs  
  a  b  is_nextElem vs a b"
apply (simp add: is_nextElem_def between_def split_def split: if_split_asm)
 apply (case_tac vs) apply simp
 apply simp
 apply (rule conjI)
  apply (rule impI)
  apply simp
 apply (case_tac "aa = b")
  apply simp
  apply (rule impI)
  apply (case_tac "list" rule: rev_exhaust)
   apply simp
  apply simp
  apply (case_tac "a = y") apply simp
  apply simp
  apply (elim conjE)
  apply (drule split_list_first)
  apply (elim exE)
  apply simp
 apply (rule impI)
 apply (subgoal_tac "b  aa")
  apply simp
  apply (case_tac "a = aa")
   apply simp
   apply (case_tac "list") apply simp
   apply simp
   apply (case_tac "aaa = b") apply (simp add: is_sublist_def) apply force
   apply simp
  apply simp
  apply (drule split_list_first)
  apply (elim exE)
  apply simp
  apply (case_tac "zs") apply simp
  apply simp
  apply (case_tac "aaa = b")
   apply simp
   apply (simp add: is_sublist_def) apply force
  apply simp
 apply force
apply (case_tac vs) apply simp
apply simp
apply (rule conjI)
 apply (rule impI) apply simp
apply (rule impI)
apply (case_tac "b = aa")
 apply simp
 apply (case_tac "list" rule: rev_exhaust) apply simp
 apply simp
 apply (case_tac "a = y") apply simp
 apply simp
 apply (drule split_list_first)
 apply (elim exE)
 apply simp
apply simp apply (case_tac "a = aa") by auto


lemma between_nextElem: "pre_between vs u v 
 between vs u (nextElem vs (hd vs) v) = between vs u v @ [v]"
apply(subgoal_tac "pre_between vs v u")
 prefer 2 apply (clarsimp simp add:pre_between_def)
apply(case_tac "before vs u v")
apply(drule (1) between_eq2)
 apply(clarsimp simp:pre_between_def hd_append split:list.split)
 apply(simp add:between_def split_def)
 apply(fastforce simp:neq_Nil_conv)
apply (simp only:before_xor)
apply(drule (1) between_eq2)
apply(clarsimp simp:pre_between_def hd_append split:list.split)
apply (simp add: append_eq_Cons_conv)
apply(fastforce simp:between_def split_def)
done



(******************** section split_face ********************************)

lemma nextVertices_in_face[simp]: "v  𝒱 f  fn  v  𝒱 f"
proof -
  assume v: "v  𝒱 f"
  then have f: "vertices f  []" by auto
  show ?thesis apply (simp add: nextVertices_def)
    apply (induct n) by (auto simp: f v)
qed



subsubsection is_nextElem edges› equivalence›


lemma is_nextElem_edges1: "distinct (vertices f)  (a,b)  edges (f::face)  is_nextElem (vertices f) a b" apply (simp add: edges_face_def nextVertex_def) apply (rule is_nextElem1) by auto


lemma is_nextElem_edges2:
 "distinct (vertices f)  is_nextElem (vertices f) a b 
 (a,b)  edges (f::face)"
apply (auto simp add: edges_face_def nextVertex_def)
apply (rule sym)
apply (rule is_nextElem2) by (auto  intro: is_nextElem_a)

lemma is_nextElem_edges_eq[simp]:
 "distinct (vertices (f::face)) 
 (a,b)  edges f = is_nextElem (vertices f) a b"
by (auto intro: is_nextElem_edges1 is_nextElem_edges2)



(*********************** nextVertex *****************************)
subsubsection @{const nextVertex}

lemma nextElem_suc2: "distinct (vertices f)  last (vertices f) = v  v  set (vertices f)  f  v = hd (vertices f)"
proof -
  assume dist: "distinct (vertices f)" and last: "last (vertices f) = v" and v: "v  set (vertices f)"
  define ls where "ls = vertices f"
  have ind: " c. distinct ls  last ls = v  v  set ls  nextElem ls c v = c"
  proof (induct ls)
    case Nil then show ?case by auto
  next
    case (Cons m ms)
    then show ?case
    proof (cases "m = v")
      case True with Cons have "ms = []"  apply (cases ms rule: rev_exhaust) by auto
      then show ?thesis by auto
    next
      case False with Cons have a1: "v  set ms" by auto
      then have ms: "ms  []" by auto

      with False Cons ms have "nextElem ms c v = c" apply (rule_tac Cons) by simp_all
      with False ms show ?thesis by simp
    qed
  qed
  from dist ls_def last v have "nextElem ls (hd ls) v = hd ls" apply (rule_tac ind) by auto
  with ls_def show ?thesis by (simp add: nextVertex_def)
qed


(*********************** split_face ****************************)
subsection @{const split_face}


definition pre_split_face :: "face  nat  nat  nat list  bool" where
"pre_split_face oldF ram1 ram2 newVertexList 
   distinct (vertices oldF)  distinct (newVertexList)
   𝒱 oldF  set newVertexList = {}
   ram1  𝒱 oldF  ram2  𝒱 oldF  ram1  ram2"

declare pre_split_face_def [simp]


lemma pre_split_face_p_between[intro]:
  "pre_split_face oldF ram1 ram2 newVertexList  pre_between (vertices oldF) ram1 ram2"  by (simp add: pre_between_def)

lemma pre_split_face_symI:
  "pre_split_face oldF ram1 ram2 newVertexList  pre_split_face oldF ram2 ram1 newVertexList" by auto


lemma pre_split_face_rev[intro]:
  "pre_split_face oldF ram1 ram2 newVertexList  pre_split_face oldF ram1 ram2 (rev newVertexList)" by auto

lemma split_face_distinct1:
  "(f12, f21) = split_face oldF ram1 ram2 newVertexList  pre_split_face oldF ram1 ram2 newVertexList 
    distinct (vertices f12)"
proof -
  assume split: "(f12, f21) = split_face oldF ram1 ram2 newVertexList" and p: "pre_split_face oldF ram1 ram2 newVertexList"
  define old_vs where "old_vs = vertices oldF"
  with p have d_old_vs: "distinct old_vs" by auto
  from p have p2: "pre_between (vertices oldF) ram1 ram2" by auto
  have rule1: "before old_vs ram1 ram2  distinct (vertices f12)"
  proof -
    assume b: "before old_vs ram1 ram2"
    with split p have "f12 = Face (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal" by (simp add: split_face_def)
    then have h1:"vertices f12 = rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]" by auto
    from p have d1: "distinct(ram1 # between (vertices oldF) ram1 ram2 @ [ram2])" by (auto del: notI)
    from b p p2 old_vs_def have d2: "set (ram1 # between (vertices oldF) ram1 ram2 @ [ram2])  set newVertexList = {}"
      by (auto dest!: splitAt_in_fst splitAt_in_snd)
    with h1 d1 p show ?thesis by auto
  qed
  have rule2: "before old_vs ram2 ram1  distinct (vertices f12)"
  proof -
    assume b: "before old_vs ram2 ram1"
    from p have p3: "pre_split_face oldF ram1 ram2 newVertexList"
       by (auto intro: pre_split_face_symI)
    then have p4: "pre_between (vertices oldF) ram2 ram1" by auto
    with split p have
     "f12 = Face (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal"
      by (simp add: split_face_def)
    then have h1:"vertices f12 = rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]"
      by auto
    from p3 have d1: "distinct(ram1 # between (vertices oldF) ram1 ram2 @ [ram2])"
    by (auto del: notI)
    from b p3 p4 old_vs_def
    have d2: "set (ram1 # between (vertices oldF) ram1 ram2 @ [ram2])  set newVertexList = {}"
      by auto
    with h1 d1 p show ?thesis by auto
  qed
  from p2 rule1 rule2 old_vs_def show ?thesis by auto
qed

lemma split_face_distinct1'[intro]:
  "pre_split_face oldF ram1 ram2 newVertexList 
    distinct (vertices (fst(split_face oldF ram1 ram2 newVertexList)))"
apply (rule_tac split_face_distinct1)
  by (auto simp del: pre_split_face_def simp: split_face_def)

lemma split_face_distinct2:
  "(f12, f21) = split_face oldF ram1 ram2 newVertexList 
   pre_split_face oldF ram1 ram2 newVertexList  distinct (vertices f21)"
proof -
  assume split: "(f12, f21) = split_face oldF ram1 ram2 newVertexList"
    and p: "pre_split_face oldF ram1 ram2 newVertexList"
  define old_vs where "old_vs = vertices oldF"
  with p have d_old_vs: "distinct old_vs" by auto
  with p have p1: "pre_split_face oldF ram1 ram2 newVertexList" by auto
  from p have p2: "pre_between (vertices oldF) ram1 ram2" by auto
  have rule1: "before old_vs ram1 ram2  distinct (vertices f21)"
  proof -
    assume b: "before old_vs ram1 ram2"
    with split p
    have "f21 = Face (ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList) Nonfinal"
      by (simp add: split_face_def)
    then have h1:"vertices f21 = ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList"
      by auto
    from p have d1: "distinct(ram1 # between (vertices oldF) ram2 ram1 @ [ram2])"
       by (auto del: notI)
    from b p1 p2 old_vs_def
    have d2: "set (ram2 # between (vertices oldF) ram2 ram1 @ [ram1])  set newVertexList = {}"
      by auto
    with h1 d1 p1 show ?thesis by auto
  qed
  have rule2: "before old_vs ram2 ram1  distinct (vertices f21)"
  proof -
    assume b: "before old_vs ram2 ram1"
    from p have p3: "pre_split_face oldF ram1 ram2 newVertexList"
      by (auto intro: pre_split_face_symI)
    then have p4: "pre_between (vertices oldF) ram2 ram1" by auto
    with split p
    have "f21 = Face (ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList) Nonfinal"
      by (simp add: split_face_def)
    then have h1:"vertices f21 = ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList"
      by auto
    from p3 have d1: "distinct(ram2 # between (vertices oldF) ram2 ram1 @ [ram1])"
      by (auto del: notI)
    from b p3 p4 old_vs_def
    have d2: "set (ram2 # between (vertices oldF) ram2 ram1 @ [ram1])  set newVertexList = {}"
      by auto
    with h1 d1 p1 show ?thesis by auto
  qed
  from p2 rule1 rule2 old_vs_def show ?thesis by auto
qed

lemma split_face_distinct2'[intro]:
  "pre_split_face oldF ram1 ram2 newVertexList  distinct (vertices (snd(split_face oldF ram1 ram2 newVertexList)))"
apply (rule_tac split_face_distinct2) by (auto simp del: pre_split_face_def simp: split_face_def)


declare pre_split_face_def [simp del]

lemma split_face_edges_or: "(f12, f21) = split_face oldF ram1 ram2 newVertexList  pre_split_face oldF ram1 ram2 newVertexList  (a, b)  edges oldF  (a,b)  edges f12  (a,b)  edges f21"
proof -
  assume nf: "(f12, f21) = split_face oldF ram1 ram2 newVertexList" and p: "pre_split_face oldF ram1 ram2 newVertexList" and old:"(a, b)  edges oldF"
  from p have d1:"distinct (vertices oldF)" by auto
  from nf p have d2: "distinct (vertices f12)" by (auto dest: pairD)
  from nf p have d3: "distinct (vertices f21)" by (auto dest: pairD)
  from p have p': "pre_between (vertices oldF) ram1 ram2" by auto
  from old d1 have is_nextElem: "is_nextElem (vertices oldF) a b" by simp
  with p have "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])  is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])" apply (rule_tac is_nextElem_or) by auto
  then have "is_nextElem (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) a b
     is_nextElem (ram2 # between (vertices oldF) ram2 ram1 @ ram1 # newVertexList) a b"
  proof (cases "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])")
    case True then show ?thesis by (auto dest: is_sublist_add intro!: is_nextElem_sublistI)
  next
    case False
    assume "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])
       is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])"
    with False have "is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])" by auto
    then show ?thesis apply (rule_tac disjI2) apply (rule_tac is_nextElem_sublistI)
      apply (subgoal_tac "is_sublist [a, b] ([] @ (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) @ newVertexList)") apply force by (frule is_sublist_add)
  qed
  with nf d1 d2 d3 show ?thesis by (simp add: split_face_def)
qed


subsection verticesFrom›

definition verticesFrom :: "face  vertex  vertex list" where
 "verticesFrom f  rotate_to (vertices f)"

lemmas verticesFrom_Def = verticesFrom_def rotate_to_def

lemma len_vFrom[simp]:
 "v  𝒱 f  |verticesFrom f v| = |vertices f|"
apply(drule split_list_first)
apply(clarsimp simp: verticesFrom_Def)
done

lemma verticesFrom_empty[simp]:
 "v  𝒱 f  (verticesFrom f v = []) = (vertices f = [])"
by(clarsimp simp: verticesFrom_Def)

lemma verticesFrom_congs:
 "v  𝒱 f  (vertices f)  (verticesFrom f v)"
by(simp add:verticesFrom_def cong_rotate_to)

lemma verticesFrom_eq_if_vertices_cong:
  "distinct(vertices f); distinct(vertices f'); 
    vertices f  vertices f'; x  𝒱 f  
   verticesFrom f x = verticesFrom f' x"
by(clarsimp simp:congs_def verticesFrom_Def splitAt_rotate_pair_conv)


lemma verticesFrom_in[intro]: "v  𝒱 f  a  𝒱 f  a  set (verticesFrom f v)"
by (auto dest: verticesFrom_congs congs_pres_nodes)

lemma verticesFrom_in': "a  set (verticesFrom f v)  a  v  a  𝒱 f"
  apply (cases "v  𝒱 f") apply (auto dest: verticesFrom_congs congs_pres_nodes)
  by (simp add: verticesFrom_Def)

lemma set_verticesFrom:
 "v  𝒱 f  set (verticesFrom f v) = 𝒱 f"
apply(auto)
apply (auto simp add: verticesFrom_Def)
done

lemma verticesFrom_hd: "hd (verticesFrom f v) = v" by (simp add: verticesFrom_Def)

lemma verticesFrom_distinct[simp]: "distinct (vertices f)  v  𝒱 f  distinct (verticesFrom f v)" apply (frule_tac verticesFrom_congs) by (auto simp: congs_distinct)

lemma verticesFrom_nextElem_eq:
 "distinct (vertices f)  v  𝒱 f  u  𝒱 f 
 nextElem (verticesFrom f v) (hd (verticesFrom f v)) u
 = nextElem (vertices f) (hd (vertices f)) u" apply (subgoal_tac "(verticesFrom f v)  (vertices f)")
 apply (rule nextElem_congs_eq) apply (auto simp: verticesFrom_congs congs_pres_nodes) apply (rule congs_sym)
 by (simp add: verticesFrom_congs)

lemma nextElem_vFrom_suc1: "distinct (vertices f)  v  𝒱 f  i < length (vertices f)  last (verticesFrom f v)  u  (verticesFrom f v)!i = u  f  u = (verticesFrom f v)!(Suc i)"
proof -
  assume dist: "distinct (vertices f)" and ith: "(verticesFrom f v)!i = u" and small_i: "i < length (vertices f)" and notlast: "last (verticesFrom f v)  u" and v: "v  𝒱 f"
  hence eq: "(vertices f)  (verticesFrom f v)" by (auto simp: verticesFrom_congs)
  from ith eq small_i have "u  set (verticesFrom f v)" by (auto simp: congs_length)
  with eq have u: "u  𝒱 f" by (auto simp: congs_pres_nodes)
  define ls where "ls = verticesFrom f v"
  with dist ith have "ls!i = u" by auto
  have ind: " c i. i < length ls  distinct ls  last ls  u  ls!i = u  u  set ls 
     nextElem ls c u = ls ! Suc i"
  proof (induct ls)
    case Nil then show ?case by auto
  next
    case (Cons m ms)
    then show ?case
    proof (cases "m = u")
      case True with Cons have "u  set ms" by auto
      with Cons True have i: "i = 0" apply (induct i) by auto
      with Cons show ?thesis  apply (simp split: if_split_asm) apply (cases ms) by simp_all
    next
      case False with Cons have a1: "u  set ms" by auto
      then have ms: "ms  []" by auto
      from False Cons have i: "0 < i" by auto
      define i' where "i' = i - 1"
      with i have i': "i = Suc i'" by auto
      with False Cons i' ms have "nextElem ms c u = ms ! Suc i'" apply (rule_tac Cons) by simp_all
      with False Cons i' ms show ?thesis by simp
    qed
  qed
  from eq dist ith ls_def small_i notlast v
  have "nextElem ls (hd ls) u = ls ! Suc i"
    apply (rule_tac ind) by (auto simp: congs_length)
  with dist u v ls_def show ?thesis by (simp add: nextVertex_def verticesFrom_nextElem_eq)
qed

lemma verticesFrom_nth: "distinct (vertices f)  d < length (vertices f) 
  v  𝒱 f  (verticesFrom f v)!d = fd  v"
proof (induct d)
  case 0 then show ?case by (simp add: verticesFrom_Def nextVertices_def)
next
  case (Suc n)
  then have dist2: "distinct (verticesFrom f v)"
     apply (frule_tac verticesFrom_congs) by (auto simp: congs_distinct)
  from Suc have in2: "v  set (verticesFrom f v)"
     apply (frule_tac verticesFrom_congs) by (auto dest: congs_pres_nodes)
  then have vFrom: "(verticesFrom f v) = butlast (verticesFrom f v) @ [last (verticesFrom f v)]"
    apply (cases "(verticesFrom f v)" rule: rev_exhaust) by auto
  from Suc show ?case
  proof (cases "last (verticesFrom f v) = fn  v")
    case True with Suc have "verticesFrom f v ! n = fn  v" by (rule_tac Suc) auto
    with True have "last (verticesFrom f v) = verticesFrom f v ! n" by auto
    with Suc dist2 in2 have "Suc n = length (verticesFrom f v)"
      apply (rule_tac nth_last_Suc_n) by auto
    with Suc show ?thesis by auto
  next
    case False with Suc show ?thesis apply (simp add: nextVertices_def) apply (rule sym)
    apply (rule_tac nextElem_vFrom_suc1) by simp_all
  qed
qed


lemma verticesFrom_length: "distinct (vertices f)  v  set (vertices f) 
  length (verticesFrom f v) = length (vertices f)"
by (auto intro: congs_length verticesFrom_congs)

lemma verticesFrom_between: "v'  𝒱 f  pre_between (vertices f) u v 
  between (vertices f) u v = between (verticesFrom f v') u v"
by (auto intro!: between_congs verticesFrom_congs)


lemma verticesFrom_is_nextElem: "v  𝒱 f 
   is_nextElem (vertices f) a b = is_nextElem (verticesFrom f v) a b"
    apply (rule is_nextElem_congs_eq) by (rule verticesFrom_congs)

lemma verticesFrom_is_nextElem_last: "v'  𝒱 f  distinct (vertices f)
   is_nextElem (verticesFrom f v') (last (verticesFrom f v')) v   v = v'"
apply (subgoal_tac "distinct (verticesFrom f v')")
apply (subgoal_tac "last (verticesFrom f v')  set (verticesFrom f v')")
apply (simp add: nextElem_is_nextElem)
apply (simp add: verticesFrom_hd)
apply (cases "(verticesFrom f v')" rule: rev_exhaust) apply (simp add: verticesFrom_Def)
by auto

lemma  verticesFrom_is_nextElem_hd: "v'  𝒱 f  distinct (vertices f)
   is_nextElem (verticesFrom f v') u v'  u = last (verticesFrom f v')"
apply (subgoal_tac "distinct (verticesFrom f v')")
apply (thin_tac "distinct (vertices f)") apply (auto simp: is_nextElem_def)
apply (drule is_sublist_y_hd) apply (simp add: verticesFrom_hd)
by auto

lemma verticesFrom_pres_nodes1: "v  𝒱 f  𝒱 f = set(verticesFrom f v)"
proof -
  assume "v  𝒱 f"
  then have "fst (splitAt v (vertices f)) @ [v] @ snd (splitAt v (vertices f)) = vertices f"
    apply (drule_tac splitAt_ram) by simp
  moreover have "set (fst (splitAt v (vertices f)) @ [v] @ snd (splitAt v (vertices f))) = set (verticesFrom f v)"
    by (auto simp: verticesFrom_Def)
  ultimately show ?thesis by simp
qed

lemma verticesFrom_pres_nodes: "v  𝒱 f  w  𝒱 f  w  set (verticesFrom f v)"
by (auto dest: verticesFrom_pres_nodes1)


lemma before_verticesFrom: "distinct (vertices f)  v  𝒱 f  w  𝒱 f 
  v  w  before (verticesFrom f v) v w"
proof -
  assume v: "v  𝒱 f" and w: "w  𝒱 f" and neq: "v  w"
  have "hd (verticesFrom f v) = v" by (rule verticesFrom_hd)
  with v have vf:"verticesFrom f v = v # tl (verticesFrom f v)"
    apply (frule_tac verticesFrom_pres_nodes1)
    apply (cases "verticesFrom f v") by auto
  moreover with v w have "w  set (verticesFrom f v)" by (auto simp: verticesFrom_pres_nodes)
  ultimately have "w  set (v # tl (verticesFrom f v))" by auto
  with neq have "w  set (tl (verticesFrom f v))" by auto
  with vf have "verticesFrom f v =
    [] @ v # fst (splitAt w (tl (verticesFrom f v))) @ w # snd (splitAt w (tl (verticesFrom f v)))"
    by (auto dest: splitAt_ram)
  then show ?thesis apply (unfold before_def) by (intro exI)
qed

lemma last_vFrom:
 " distinct(vertices f); x  𝒱 f   last(verticesFrom f x) = f-1  x"
apply(frule split_list)
apply(clarsimp simp:prevVertex_def verticesFrom_Def split:list.split)
done


lemma rotate_before_vFrom:
  " distinct(vertices f); r  𝒱 f; ru  
   before (verticesFrom f r) u v  before (verticesFrom f v) r u"
using [[linarith_neq_limit = 1]]
apply(frule split_list)
apply(clarsimp simp:verticesFrom_Def)
apply(rename_tac as bs)
apply(clarsimp simp:before_def)
apply(rename_tac xs ys zs)
apply(subst (asm) Cons_eq_append_conv)
apply clarsimp
apply(rename_tac bs')
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(rename_tac as')
apply(erule disjE)
 defer
 apply clarsimp
 apply(rule_tac x = "v#zs" in exI)
 apply(rule_tac x = "bs@as'" in exI)
 apply simp
apply clarsimp
apply(subst (asm) append_eq_Cons_conv)
apply(erule disjE)
apply clarsimp
apply(rule_tac x = "v#zs" in exI)
apply simp apply blast
apply clarsimp
apply(rename_tac ys')
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(rename_tac vs')
apply(erule disjE)
 apply clarsimp
 apply(subst (asm) append_eq_Cons_conv)
 apply(erule disjE)
  apply clarsimp
  apply(rule_tac x = "v#zs" in exI)
  apply simp apply blast
 apply clarsimp
 apply(rule_tac x = "v#ys'@as" in exI)
 apply simp apply blast
apply clarsimp
apply(rule_tac x = "v#zs" in exI)
apply simp apply blast
done

lemma before_between:
 " before(verticesFrom f x) y z; distinct(vertices f); x  𝒱 f; x  y  
  y  set(between (vertices f) x z)"
apply(induct f)
apply(clarsimp simp:verticesFrom_Def before_def)
apply(frule split_list)
apply(clarsimp simp:Cons_eq_append_conv)
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(erule disjE)
 apply(clarsimp simp:append_eq_Cons_conv)
 prefer 2 apply(clarsimp simp add:between_def split_def)
apply(erule disjE)
 apply (clarsimp simp:between_def split_def)
apply clarsimp
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(erule disjE)
 prefer 2 apply(clarsimp simp add:between_def split_def)
apply(clarsimp simp:append_eq_Cons_conv)
apply(fastforce simp:between_def split_def)
done

lemma before_between2:
 " before (verticesFrom f u) v w; distinct(vertices f); u  𝒱 f 
   u = v  u  set (between (vertices f) w v)"
apply(subgoal_tac "pre_between (vertices f) v w")
 apply(subst verticesFrom_between)
   apply assumption
  apply(erule pre_between_symI)
 apply(frule pre_between_r1)
 apply(drule (1) verticesFrom_distinct)
 using verticesFrom_hd[of f u]
 apply(clarsimp simp add:before_def between_def split_def hd_append
                split:if_split_asm)
apply(frule (1) verticesFrom_distinct)
apply(clarsimp simp:pre_between_def before_def simp del:verticesFrom_distinct)
apply(rule conjI)
 apply(cases "v = u")
  apply simp
 apply(rule verticesFrom_in'[of v f u])apply simp apply assumption
apply(cases "w = u")
 apply simp
apply(rule verticesFrom_in'[of w f u])apply simp apply assumption
done


(************************** splitFace ********************************)


subsection @{const splitFace}


definition pre_splitFace :: "graph  vertex  vertex  face  vertex list  bool" where
  "pre_splitFace g ram1 ram2 oldF nvs 
  oldF   g  ¬ final oldF  distinct (vertices oldF)  distinct nvs
   𝒱 g  set nvs = {}
   𝒱 oldF  set nvs = {}
   ram1  𝒱 oldF  ram2  𝒱 oldF
   ram1  ram2
   (((ram1,ram2)  edges oldF  (ram2,ram1)  edges oldF
      (ram1, ram2)  edges g  (ram2, ram1)  edges g)  nvs  [])"

declare pre_splitFace_def [simp]

lemma pre_splitFace_pre_split_face[simp]:
  "pre_splitFace g ram1 ram2 oldF nvs  pre_split_face oldF ram1 ram2 nvs"
 by (simp add: pre_splitFace_def pre_split_face_def)

lemma pre_splitFace_oldF[simp]:
  "pre_splitFace g ram1 ram2 oldF nvs  oldF   g"
  apply (unfold pre_splitFace_def) by force

declare pre_splitFace_def [simp del]

lemma splitFace_split_face:
     "oldF   g 
     (f1, f2, newGraph) = splitFace g ram1 ram2 oldF newVs 
     (f1, f2) = split_face oldF ram1 ram2 newVs"
  by (simp add: splitFace_def split_def)


(* split_face *)
lemma split_face_empty_ram2_ram1_in_f12:
  "pre_split_face oldF ram1 ram2 [] 
  (f12, f21) = split_face oldF ram1 ram2 []  (ram2, ram1)  edges f12"
proof -
  assume split: "(f12, f21) = split_face oldF ram1 ram2 []"
  "pre_split_face oldF ram1 ram2 []"
  then have "ram2  𝒱 f12" by (simp add: split_face_def)
  moreover with split have "f12  ram2 = hd (vertices f12)"
   apply (rule_tac nextElem_suc2)
   apply (simp add: pre_split_face_def split_face_distinct1)
   by (simp add: split_face_def)
  with split have "ram1 = f12  ram2"
   by (simp add: split_face_def)
  ultimately show ?thesis by (simp add: edges_face_def)
qed

lemma split_face_empty_ram2_ram1_in_f12':
  "pre_split_face oldF ram1 ram2 [] 
  (ram2, ram1)  edges (fst (split_face oldF ram1 ram2 []))"
proof -
  assume split: "pre_split_face oldF ram1 ram2 []"
  define f12 where "f12 = fst (split_face oldF ram1 ram2 [])"
  define f21 where "f21 = snd (split_face oldF ram1 ram2 [])"
  then have "(f12, f21) = split_face oldF ram1 ram2 []" by (simp add: f12_def f21_def)
  with split have "(ram2, ram1)  edges f12"
    by (rule split_face_empty_ram2_ram1_in_f12)
  with f12_def show ?thesis by simp
qed

lemma splitFace_empty_ram2_ram1_in_f12:
  "pre_splitFace g ram1 ram2 oldF [] 
  (f12, f21, newGraph) = splitFace g ram1 ram2 oldF [] 
  (ram2, ram1)  edges f12"
proof -
  assume pre: "pre_splitFace g ram1 ram2 oldF []"
  then have oldF: "oldF   g" by (unfold pre_splitFace_def) simp
  assume sp: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF []"
  with oldF have "(f12, f21) = split_face oldF ram1 ram2 []"
    by (rule splitFace_split_face)

  with pre sp show ?thesis
  apply (unfold  splitFace_def pre_splitFace_def)
  apply (simp add: split_def)
  apply (rule split_face_empty_ram2_ram1_in_f12')
  apply (rule pre_splitFace_pre_split_face)
  apply (rule pre)
  done
qed

lemma splitFace_f12_new_vertices:
  "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs 
  v  set  newVs  v  𝒱 f12"
  apply (unfold splitFace_def)
  apply (simp add: split_def)
  apply (unfold split_face_def Let_def)
  by simp


lemma splitFace_add_vertices_direct[simp]:
"vertices (snd (snd (splitFace g ram1 ram2 oldF [countVertices g ..< countVertices g + n])))
  = vertices g @ [countVertices g ..< countVertices g + n]"
  apply (auto simp: splitFace_def split_def) apply (cases g)
  apply auto  apply (induct n) by auto

lemma splitFace_delete_oldF:
" (f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVertexList 
 oldF  f12  oldF  f21  distinct (faces g) 
 oldF   newGraph"
by (simp add: splitFace_def split_def distinct_set_replace)

lemma splitFace_faces_1:
"(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVertexList 
oldF   g 
set (faces newGraph)  {oldF} = {f12, f21}  set (faces g)"
(is "?oldF  ?C  ?A = ?B")
proof (intro equalityI subsetI)
  fix x
  assume "x  ?A" and "?C" and "?oldF"
  then show "x  ?B" apply (simp add: splitFace_def split_def) by (auto dest: replace1)
next
  fix x
  assume "x  ?B" and "?C" and "?oldF"
  then show "x  ?A" apply (simp add: splitFace_def split_def)
    apply (cases "x = oldF") apply simp_all
    apply (cases "x = f12")  apply simp_all
    apply (cases "x = f21")  by (auto intro: replace3 replace4)
qed


lemma splitFace_distinct1[intro]:"pre_splitFace g ram1 ram2 oldF newVertexList 
  distinct (vertices (fst (snd (splitFace g ram1 ram2 oldF newVertexList))))"
  apply (unfold  splitFace_def split_def)
  by (auto simp add: split_def)

lemma splitFace_distinct2[intro]:"pre_splitFace g ram1 ram2 oldF newVertexList 
  distinct (vertices (fst (splitFace g ram1 ram2 oldF newVertexList)))"
  apply (unfold  splitFace_def split_def)
  by (auto simp add: split_def)


lemma splitFace_add_f21': "f'   g'  fst (snd (splitFace g' v a f' nvl))
             (snd (snd (splitFace g' v a f' nvl)))"
apply (simp add: splitFace_def split_def) apply (rule disjI2)
apply (rule replace3) by simp_all

lemma split_face_help[simp]: "Suc 0 < |vertices (fst (split_face f' v a nvl))|"
  by (simp add: split_face_def)

lemma split_face_help'[simp]: "Suc 0 < |vertices (snd (split_face f' v a nvl))|"
 by (simp add: split_face_def)

lemma splitFace_split: "f   (snd (snd (splitFace g v a f' nvl))) 
  f   g
    f = fst (splitFace g v a f' nvl)
    f = (fst (snd (splitFace g v a f' nvl)))"
 apply (simp add: splitFace_def split_def)
 apply safe by (frule replace5)  simp

lemma pre_FaceDiv_between1: "pre_splitFace g' ram1 ram2 f [] 
  ¬ between (vertices f) ram1 ram2 = []"
proof -
  assume pre_f: "pre_splitFace g' ram1 ram2 f []"
  then have pre_bet: "pre_between (vertices f) ram1 ram2" apply (unfold pre_splitFace_def)
    by (simp add: pre_between_def)
  then have pre_bet': "pre_between (verticesFrom f ram1) ram1 ram2"
    by (simp add: pre_between_def set_verticesFrom)
  from pre_f have dist': "distinct (verticesFrom f ram1)" apply (unfold pre_splitFace_def) by simp
  from pre_f have ram2: "ram2  𝒱 f" apply (unfold pre_splitFace_def) by simp
  from pre_f have "¬ is_nextElem (vertices f) ram1 ram2" apply (unfold pre_splitFace_def) by auto
  with pre_f have "¬ is_nextElem (verticesFrom f ram1) ram1 ram2" apply (unfold pre_splitFace_def)
    by (simp add: verticesFrom_is_nextElem [symmetric])
  moreover
  from pre_f have "ram2  set (verticesFrom f ram1)" apply (unfold pre_splitFace_def) by auto
  moreover
  from pre_f have "ram2   ram1" apply (unfold pre_splitFace_def) by auto
  ultimately have ram2_not: "ram2   hd (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
    apply (simp add: is_nextElem_def verticesFrom_Def)
    apply (cases "snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f))")
    apply simp apply simp
    apply (simp add: is_sublist_def) by auto


  from pre_f have before: "before (verticesFrom f ram1) ram1 ram2" apply (unfold pre_splitFace_def)
    apply safe apply (rule before_verticesFrom) by auto
  have "fst (splitAt ram2 (snd (splitAt ram1 (verticesFrom f ram1)))) = []  False"
  proof -
    assume  "fst (splitAt ram2 (snd (splitAt ram1 (verticesFrom f ram1)))) = []"
    moreover
    from ram2 pre_f have "ram2  set (verticesFrom f ram1)"apply (unfold pre_splitFace_def)
      by auto
    with pre_f have "ram2  set (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
      apply (simp add: verticesFrom_Def)
      apply (unfold pre_splitFace_def)  by auto
    moreover
    note dist'
    ultimately  have "ram2 = hd (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
      apply (rule_tac ccontr)
      apply (cases "(snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))")
      apply simp
      apply simp
      by (simp add: verticesFrom_Def del: distinct_append)
    with ram2_not show ?thesis by auto
  qed
  with before pre_bet' have  "between (verticesFrom f ram1) ram1 ram2   []" by auto
  with pre_f pre_bet show ?thesis apply (unfold pre_splitFace_def) apply safe
  by (simp add: verticesFrom_between)
qed

lemma pre_FaceDiv_between2: "pre_splitFace g' ram1 ram2 f [] 
  ¬ between (vertices f) ram2 ram1 = []"
proof -
  assume pre_f: "pre_splitFace g' ram1 ram2 f []"
  then have "pre_splitFace g' ram2 ram1 f []" apply (unfold pre_splitFace_def) by auto
  then show ?thesis by (rule pre_FaceDiv_between1)
qed


(********************** Edges *******************)

definition Edges :: "vertex list  (vertex × vertex) set" where
"Edges vs  {(a,b). is_sublist [a,b] vs}"

lemma Edges_Nil[simp]: "Edges [] = {}"
by(simp add:Edges_def is_sublist_def)

lemma Edges_rev:
 "Edges (rev (zs::vertex list)) = {(b,a). (a,b)  Edges zs}"
  by (auto simp add: Edges_def is_sublist_rev)

lemma in_Edges_rev[simp]:
 "((a,b) : Edges (rev (zs::vertex list))) = ((b,a)  Edges zs)"
by (simp add: Edges_rev)

lemma notinset_notinEdge1: "x  set xs  (x,y)  Edges xs"
by(unfold Edges_def)(blast intro:is_sublist_in)

lemma notinset_notinEdge2: "y  set xs  (x,y)  Edges xs"
by(unfold Edges_def)(blast intro:is_sublist_in1)

lemma in_Edges_in_set: "(x,y) : Edges vs  x  set vs  y  set vs"
by(unfold Edges_def)(blast intro:is_sublist_in is_sublist_in1)


lemma edges_conv_Edges:
  "distinct(vertices(f::face))   f =
   Edges (vertices f) 
  (if vertices f = [] then {} else {(last(vertices f), hd(vertices f))})"
by(induct f) (auto simp: Edges_def is_nextElem_def)


lemma Edges_Cons: "Edges(x#xs) =
  (if xs = [] then {} else Edges xs  {(x,hd xs)})"
apply(auto simp:Edges_def)
   apply(rule ccontr)
   apply(simp)
  apply(erule thin_rl)
  apply(erule contrapos_np)
  apply(clarsimp simp:is_sublist_def Cons_eq_append_conv)
  apply(rename_tac as bs)
  apply(erule disjE)
   apply simp
  apply(clarsimp)
  apply(rename_tac cs)
  apply(rule_tac x = cs in exI)
  apply(rule_tac x = bs in exI)
  apply(rule HOL.refl)
 apply(clarsimp simp:neq_Nil_conv)
 apply(subst is_sublist_rec)
 apply simp
apply(simp add:is_sublist_def)
apply(erule exE)+
apply(rename_tac as bs)
apply simp
apply(rule_tac x = "x#as" in exI)
apply(rule_tac x = bs in exI)
apply simp
done

lemma Edges_append: "Edges(xs @ ys) =
  (if xs = [] then Edges ys else
   if ys = [] then Edges xs else
   Edges xs  Edges ys  {(last xs, hd ys)})"
apply(induct xs)
 apply simp
apply (simp add:Edges_Cons)
apply blast
done


lemma Edges_rev_disj: "distinct xs  Edges(rev xs)  Edges(xs) = {}"
apply(induct xs)
 apply simp
apply(auto simp:Edges_Cons Edges_append last_rev
      notinset_notinEdge1 notinset_notinEdge2)
done

lemma disj_sets_disj_Edges:
 "set xs  set ys = {}  Edges xs  Edges ys = {}"
by(unfold Edges_def)(blast intro:is_sublist_in is_sublist_in1)

lemma disj_sets_disj_Edges2:
 "set ys  set xs = {}  Edges xs  Edges ys = {}"
by(blast intro!:disj_sets_disj_Edges)


lemma finite_Edges[iff]: "finite(Edges xs)"
by(induct xs)(simp_all add:Edges_Cons)


lemma Edges_compl:
 " distinct vs; x  set vs; y  set vs; x  y  
 Edges(x # between vs x y @ [y])  Edges(y # between vs y x @ [x]) = {}"
using [[linarith_neq_limit = 1]]
apply(subgoal_tac
 "xs (ys::vertex list). xs  []  set xs  set ys = {}  hd xs  set ys")
 prefer 2 apply(drule hd_in_set) apply(blast)
apply(frule split_list[of  x])
apply clarsimp
apply(erule disjE)
 apply(frule split_list[of y])
 apply(clarsimp simp add:between_def split_def)
 apply (clarsimp simp add:Edges_Cons Edges_append
    notinset_notinEdge1 notinset_notinEdge2
    disj_sets_disj_Edges disj_sets_disj_Edges2
    Int_Un_distrib Int_Un_distrib2)
 apply(fastforce)
apply(frule split_list[of y])
apply(clarsimp simp add:between_def split_def)
apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
 notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
 Int_Un_distrib Int_Un_distrib2)
apply fastforce
done

lemma Edges_disj:
 " distinct vs; x  set vs; z  set vs; x  y; y  z;
    y  set(between vs x z)  
 Edges(x # between vs x y @ [y])  Edges(y # between vs y z @ [z]) = {}"
apply(subgoal_tac
 "xs (ys::vertex list). xs  []  set xs  set ys = {}  hd xs  set ys")
 prefer 2 apply(drule hd_in_set) apply(blast)
apply(frule split_list[of x])
apply clarsimp
apply(erule disjE)
 apply simp
 apply(drule inbetween_inset)
 apply(rule Edges_compl)
    apply simp
   apply simp
  apply simp
 apply simp
apply(erule disjE)
 apply(frule split_list[of z])
 apply(clarsimp simp add:between_def split_def)
 apply(erule disjE)
  apply(frule split_list[of y])
  apply clarsimp
  apply (clarsimp simp add:Edges_Cons Edges_append
    notinset_notinEdge1 notinset_notinEdge2
    disj_sets_disj_Edges disj_sets_disj_Edges2
    Int_Un_distrib Int_Un_distrib2)
  apply fastforce
 apply(frule split_list[of y])
 apply clarsimp
 apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
 notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
 Int_Un_distrib Int_Un_distrib2)
 apply fastforce
apply(frule split_list[of z])
apply(clarsimp simp add:between_def split_def)
apply(frule split_list[of y])
apply clarsimp
apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
 notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
 Int_Un_distrib Int_Un_distrib2)
apply fastforce
done

lemma edges_conv_Un_Edges:
 " distinct(vertices(f::face)); x  𝒱 f; y  𝒱 f; x  y  
   f = Edges(x # between (vertices f) x y @ [y]) 
           Edges(y # between (vertices f) y x @ [x])"
apply(simp add:edges_conv_Edges)
apply(rule conjI)
 apply clarsimp
apply clarsimp
apply(frule split_list[of  x])
apply clarsimp
apply(erule disjE)
 apply(frule split_list[of y])
 apply(clarsimp simp add:between_def split_def)
 apply (clarsimp simp add:Edges_Cons Edges_append
    notinset_notinEdge1 notinset_notinEdge2
    disj_sets_disj_Edges disj_sets_disj_Edges2
    Int_Un_distrib Int_Un_distrib2)
 apply(fastforce)
apply(frule split_list[of y])
apply(clarsimp simp add:between_def split_def)
apply (clarsimp simp add:Edges_Cons Edges_append
    notinset_notinEdge1 notinset_notinEdge2
    disj_sets_disj_Edges disj_sets_disj_Edges2
    Int_Un_distrib Int_Un_distrib2)
apply(fastforce)
done


lemma Edges_between_edges:
  " (a,b)  Edges (u # between (vertices(f::face)) u v @ [v]);
    pre_split_face f u v vs   (a,b)   f"
apply(simp add:pre_split_face_def)
apply(induct f)
apply(simp add:edges_conv_Edges Edges_Cons)
apply clarify
apply(rename_tac list)
apply(case_tac "between list u v = []")
 apply simp
 apply(drule (4) is_nextElem_between_empty')
 apply(simp add:Edges_def)
apply(subgoal_tac "pre_between list u v")
 prefer 2 apply (simp add:pre_between_def)
apply(subgoal_tac "pre_between list v u")
 prefer 2 apply (simp add:pre_between_def)
apply(case_tac "before list u v")
 apply(drule (1) between_eq2)
 apply clarsimp
 apply(erule disjE)
  apply (clarsimp simp:neq_Nil_conv)
  apply(rule is_nextElem_sublistI)
  apply(simp (no_asm) add:is_sublist_def)
  apply blast
 apply(rule is_nextElem_sublistI)
 apply(clarsimp simp add:Edges_def is_sublist_def)
 apply(rename_tac as bs cs xs ys)
 apply(rule_tac x = "as @ u # xs" in exI)
 apply(rule_tac x = "ys @ cs" in exI)
 apply simp
apply (simp only:before_xor)
apply(drule (1) between_eq2)
apply clarsimp
apply(rename_tac as bs cs)
apply(erule disjE)
 apply (clarsimp simp:neq_Nil_conv)
 apply(case_tac cs)
  apply clarsimp
  apply(simp add:is_nextElem_def)
 apply simp
 apply(rule is_nextElem_sublistI)
 apply(simp (no_asm) add:is_sublist_def)
 apply(rule_tac x = "as @ v # bs" in exI)
 apply simp
apply(rule_tac m1 = "|as|+1" in is_nextElem_rotate_eq[THEN iffD1])
apply simp
apply(simp add:rotate_drop_take)
apply(rule is_nextElem_sublistI)
apply(clarsimp simp add:Edges_def is_sublist_def)
apply(rename_tac xs ys)
apply(rule_tac x = "bs @ u # xs" in exI)
apply simp
done


(******************** split_face_edges ********************************)


(* split_face *)

lemma edges_split_face1: "pre_split_face f u v vs 
 (fst(split_face f u v vs)) =
 Edges(v # rev vs @ [u])  Edges(u # between (vertices f) u v @ [v])"
apply(simp add: edges_conv_Edges split_face_distinct1')
apply(auto simp add:split_face_def Edges_Cons Edges_append)
done

lemma edges_split_face2: "pre_split_face f u v vs 
 (snd(split_face f u v vs)) =
 Edges(u # vs @ [v])  Edges(v # between (vertices f) v u @ [u])"
apply(simp add: edges_conv_Edges split_face_distinct2')
apply(auto simp add:split_face_def Edges_Cons Edges_append)
done

lemma split_face_empty_ram1_ram2_in_f21:
  "pre_split_face oldF ram1 ram2 [] 
  (f12, f21) = split_face oldF ram1 ram2 []  (ram1, ram2)  edges f21"
proof -
  assume split: "(f12, f21) = split_face oldF ram1 ram2 []"
  "pre_split_face oldF ram1 ram2 []"
  then have "ram1  𝒱 f21" by (simp add: split_face_def)
  moreover with split have "f21  ram1 = hd (vertices f21)"
   apply (rule_tac nextElem_suc2)
   apply (simp add: pre_split_face_def split_face_distinct2)
   by (simp add: split_face_def)
  with split have "ram2 = f21  ram1"
   by (simp add: split_face_def)
  ultimately show ?thesis by (simp add: edges_face_def)
qed

lemma split_face_empty_ram1_ram2_in_f21':
  "pre_split_face oldF ram1 ram2 [] 
  (ram1, ram2)  edges (snd (split_face oldF ram1 ram2 []))"
proof -
  assume split: "pre_split_face oldF ram1 ram2 []"
  define f12 where "f12 = fst (split_face oldF ram1 ram2 [])"
  define f21 where "f21 = snd (split_face oldF ram1 ram2 [])"
  then have "(f12, f21) = split_face oldF ram1 ram2 []" by (simp add: f12_def f21_def)
  with split have "(ram1, ram2)  edges f21"
    by (rule split_face_empty_ram1_ram2_in_f21)
  with f21_def show ?thesis by simp
qed

lemma splitFace_empty_ram1_ram2_in_f21:
  "pre_splitFace g ram1 ram2 oldF [] 
  (f12, f21, newGraph) = splitFace g ram1 ram2 oldF [] 
  (ram1, ram2)  edges f21"
proof -
  assume pre: "pre_splitFace g ram1 ram2 oldF []"
  then have oldF: "oldF   g" by (unfold pre_splitFace_def) simp
  assume sp: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF []"
  with oldF have "(f12, f21) = split_face oldF ram1 ram2 []"
    by (rule splitFace_split_face)

  with pre sp show ?thesis
  apply (unfold  splitFace_def pre_splitFace_def)
  apply (simp add: split_def)
  apply (rule split_face_empty_ram1_ram2_in_f21')
  apply (rule pre_splitFace_pre_split_face)
  apply (rule pre)
  done
qed

lemma splitFace_f21_new_vertices:
  "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs 
  v  set  newVs  v  𝒱 f21"
  apply (unfold splitFace_def)
  apply (simp add: split_def)
  apply (unfold split_face_def)
  by simp

lemma split_face_edges_f12:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "(f12, f21) = split_face f ram1 ram2 vs"
              "vs  []" "vs1 = between (vertices f) ram1 ram2" "vs1  []"
shows "edges f12 =
      {(hd vs, ram1) , (ram1, hd vs1), (last vs1, ram2), (ram2, last vs)} 
      Edges(rev vs)  Edges vs1" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
    apply (case_tac "c = ram2  d = last vs") apply simp apply simp apply (elim exE)
    apply (case_tac "c = ram1") apply simp
     apply (subgoal_tac "between (vertices f) ram1 ram2 @ [ram2] = d # bs")
      apply (case_tac "between (vertices f) ram1 ram2") apply simp apply simp
     apply (rule dist_at2) apply (rule dist_f12) apply (rule sym) apply simp  apply simp
    (* c ≠ ram1 *)
    apply (case_tac "c  set(rev vs)")
     apply (subgoal_tac "distinct(rev vs)") apply (simp only: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac "zs") apply simp
       apply (subgoal_tac "ys = as") apply(drule last_rev) apply (simp)
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp
       apply simp
      apply (simp add:rev_swap)
      apply (subgoal_tac "ys = as")
       apply (clarsimp simp add: Edges_def is_sublist_def)
       apply (rule conjI)
        apply (subgoal_tac "as bs. rev list @ [d, c] = as @ d # c # bs") apply simp apply (intro exI) apply simp
       apply (subgoal_tac "asa bs. rev list @ d # c # rev as = asa @ d # c # bs") apply simp  apply (intro exI) apply simp
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
    apply (simp add: pre_split_face_def)
    (* c ∉ set vs *)
    apply (case_tac "c  set (between (vertices f) ram1 ram2)")
     apply (subgoal_tac "distinct (between (vertices f) ram1 ram2)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac zs) apply simp apply (subgoal_tac "rev vs @ ram1 # ys = as") apply force
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
      apply simp
      apply (subgoal_tac "rev vs @ ram1 # ys = as") apply (simp add: Edges_def is_sublist_def)
       apply (subgoal_tac "(rev vs @ ram1 # ys) @ c # a # list @ [ram2] = as @ c # d # bs") apply simp
        apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply (rule exI) apply force
        apply (rule impI) apply (rule disjI2)+ apply force
       apply force
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
     apply (thin_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs")
     apply (subgoal_tac "distinct (vertices f12)") apply simp
     apply (rule dist_f12)
      (* c ∉  set (between (vertices f) ram1 ram2) *)
    apply (subgoal_tac "c = ram2") apply simp
     apply (subgoal_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 = as") apply force
     apply (rule dist_at1) apply (rule dist_f12) apply (rule sym)  apply simp apply simp

    (* c ≠ ram2 *)
    apply (subgoal_tac "c  set (rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2])")
     apply (thin_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs") apply simp
    by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    apply (case_tac "c = ram2  d = last vs") apply simp
    apply (rule disjCI) apply simp
    apply (case_tac "c = hd vs  d = ram1")
     apply (case_tac "vs") apply simp
     apply force
    apply simp
    apply (case_tac "c = ram1  d = hd (between (vertices f) ram1 ram2)")
     apply (case_tac "between (vertices f) ram1 ram2") apply simp apply force
    apply simp
    apply (case_tac "c = last (between (vertices f) ram1 ram2)  d = ram2")
     apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
     apply simp
     apply (intro exI) apply (subgoal_tac "rev vs @ ram1 # ys @ [y, ram2] = (rev vs @ ram1 # ys) @ y # ram2 # []")
      apply assumption
     apply simp
    apply simp
    apply (case_tac "(d,c)  Edges vs") apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (intro exI) apply simp
    apply (simp add: Edges_def is_sublist_def)
    apply (elim exE) apply simp apply (intro exI)
    apply (subgoal_tac "rev vs @ ram1 # as @ c # d # bs @ [ram2] = (rev vs @ ram1 # as) @ c # d # bs @ [ram2]")
     apply assumption
    by simp
qed

lemma split_face_edges_f12_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
              "(f12, f21) = split_face f ram1 ram2 []"
              "vs1 = between (vertices f) ram1 ram2" "vs1  []"
shows "edges f12 = {(ram2, ram1) , (ram1, hd vs1), (last vs1, ram2)} 
                   Edges vs1" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
    apply (case_tac " c = ram2  d = ram1") apply simp
    apply simp apply (elim exE)
    apply (case_tac "c = ram1") apply simp
     apply (subgoal_tac "as = []") apply simp
      apply (case_tac "between (vertices f) ram1 ram2") apply simp
      apply simp
     apply (rule dist_at1) apply (rule dist_f12) apply force apply (rule sym) apply simp
    (* a ≠ ram1 *)
    apply (case_tac "c  set (between (vertices f) ram1 ram2)")
     apply (subgoal_tac "distinct (between (vertices f) ram1 ram2)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac zs) apply simp apply (subgoal_tac "ram1 # ys = as") apply force
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
      apply simp
      apply (subgoal_tac "ram1 # ys = as") apply (simp add: Edges_def is_sublist_def)
       apply (subgoal_tac "(ram1 # ys) @ c # a # list @ [ram2] = as @ c # d # bs") apply simp
        apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply (rule exI) apply force
        apply (rule impI) apply (rule disjI2)+ apply force
       apply force
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
     apply (thin_tac "ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs")
     apply (subgoal_tac "distinct (vertices f12)") apply simp
     apply (rule dist_f12)
      (* c ∉  set (between (vertices f) ram1 ram2) *)
    apply (subgoal_tac "c = ram2") apply simp
     apply (subgoal_tac "ram1 # between (vertices f) ram1 ram2 = as") apply force
     apply (rule dist_at1) apply (rule dist_f12) apply (rule sym)  apply simp apply simp

    (* c ≠ ram2 *)
    apply (subgoal_tac "c  set (ram1 # between (vertices f) ram1 ram2 @ [ram2])")
     apply (thin_tac "ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs") apply simp
    by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    apply (case_tac "c = ram2  d = ram1") apply simp
    apply (rule disjCI) apply simp
    apply (case_tac "c = ram1  d = hd (between (vertices f) ram1 ram2)")
     apply (case_tac "between (vertices f) ram1 ram2") apply simp
     apply force
    apply simp
    apply (case_tac "c = last (between (vertices f) ram1 ram2)  d = ram2")
     apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
     apply simp
     apply (intro exI) apply (subgoal_tac "ram1 # ys @ [y, ram2] = (ram1 # ys) @ y # ram2 # []")
      apply assumption
     apply simp
    apply simp
    apply (case_tac "(c, d)  Edges vs") apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (intro exI)
     apply (subgoal_tac "ram1 # as @ c # d # bs @ [ram2] = (ram1 # as) @ c # d # (bs @ [ram2])") apply assumption
     apply simp
    apply (simp add: Edges_def is_sublist_def)
    apply (elim exE) apply simp apply (intro exI)
    apply (subgoal_tac "ram1 # as @ c # d # bs @ [ram2] = (ram1 # as) @ c # d # bs @ [ram2]")
     apply assumption
    by simp
qed

lemma split_face_edges_f12_bet:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "(f12, f21) = split_face f ram1 ram2 vs"
              "vs  []" "between (vertices f) ram1 ram2 = []"
shows "edges f12 = {(hd vs, ram1) , (ram1, ram2), (ram2, last vs)} 
                   Edges(rev vs)" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
    apply (case_tac " c = ram2  d = last vs") apply simp
    apply simp apply (elim exE)
    apply (case_tac "c = ram1") apply simp
     apply (subgoal_tac "rev vs = as") apply simp
     apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp  apply simp
    (* a ≠ ram1 *)
    apply (case_tac "c  set(rev vs)")
     apply (subgoal_tac "distinct(rev vs)") apply (simp only: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac "zs") apply simp apply (subgoal_tac "ys = as") apply (simp add:rev_swap)
       apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp apply simp
      apply (subgoal_tac "ys = as") apply (simp add: Edges_def is_sublist_def rev_swap)
       apply (rule conjI)
        apply (subgoal_tac "as bs. rev list @ [d, c] = as @ d # c # bs") apply simp apply (intro exI) apply simp
       apply (subgoal_tac "asa bs. rev list @ d # c # rev as = asa @ d # c # bs") apply simp  apply (intro exI) apply simp
      apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
     apply (simp add: pre_split_face_def)
    (* c ∉ set vs *)
    apply (subgoal_tac "c = ram2") apply simp
     apply (subgoal_tac "rev vs @ [ram1] = as") apply force
     apply (rule dist_at1) apply (rule dist_f12) apply (rule sym)  apply simp apply simp

    (* c ≠ ram2 *)
    apply (subgoal_tac "c  set (rev vs @ ram1 # [ram2])")
     apply (thin_tac "rev vs @ ram1 # [ram2] = as @ c # d # bs") apply simp
    by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?lhs"
    apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    apply (case_tac "c = hd vs  d = ram1")
     apply (case_tac "vs") apply simp
     apply force
    apply simp
    apply (case_tac "c = ram1  d = ram2") apply force
    apply simp
    apply (case_tac "c = ram2  d = last vs")
     apply (case_tac "vs" rule:rev_exhaust) apply simp
     apply simp
    apply (simp add: Edges_def is_sublist_def)
    apply (elim exE) apply simp apply (rule conjI)
     apply (rule impI) apply (rule disjI1) apply (intro exI)
     apply (subgoal_tac "c # d # rev as @ [ram1, ram2] = [] @ c # d # rev as @ [ram1,ram2]") apply assumption apply simp
    apply (rule impI) apply (rule disjI1) apply (intro exI) by simp
qed

lemma split_face_edges_f12_bet_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
              "(f12, f21) = split_face f ram1 ram2 []"
              "between (vertices f) ram1 ram2 = []"
shows "edges f12 = {(ram2, ram1) , (ram1, ram2)}" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
    apply (case_tac " c = ram2  d = ram1") apply force
    apply simp apply (elim exE)
    apply (case_tac "c = ram1")  apply simp
     apply (case_tac "as") apply simp
    apply (case_tac "list") apply simp apply simp
    apply (case_tac "as") apply simp apply (case_tac "list") apply simp by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
  from x vors show "x  ?lhs"
    apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    by auto
qed


lemma split_face_edges_f12_subset: "pre_split_face f ram1 ram2 vs 
  (f12, f21) = split_face f ram1 ram2 vs  vs  [] 
  {(hd vs, ram1), (ram2, last vs)}  Edges(rev vs)  edges f12"
  apply (case_tac "between (vertices f) ram1 ram2")
    apply (frule split_face_edges_f12_bet)  apply simp apply simp apply simp apply force
    apply (frule split_face_edges_f12) apply simp+ by force

(*declare in_Edges_rev [simp del] rev_eq_Cons_iff [simp del]*)

lemma split_face_edges_f21:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "(f12, f21) = split_face f ram1 ram2 vs"
              "vs  []" "vs2 = between (vertices f) ram2 ram1" "vs2  []"
shows "edges f21 = {(last vs2, ram1) , (ram1, hd vs), (last vs, ram2), (ram2, hd vs2)} 
  Edges vs  Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
    apply (case_tac " c = last vs  d = ram2") apply simp
    apply simp apply (elim exE)
    apply (case_tac "c = ram1") apply simp
     apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 = as")
      apply clarsimp
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
    (* a ≠ ram1 *)
    apply (case_tac "c  set vs")
     apply (subgoal_tac "distinct vs")
      apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac "zs") apply simp
       apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys = as") apply force
       apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
      apply simp
      apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys = as")
       apply (subgoal_tac "(ram2 # between (vertices f) ram2 ram1 @ ram1 # ys) @ c # a # list = as @ c # d # bs")
        apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys @ c # a # list = as @ c # d # bs")
        apply (simp add: Edges_def is_sublist_def)
        apply(rule conjI)
         apply (subgoal_tac "as bs. ys @ [c, d] = as @ c # d # bs") apply simp apply force
        apply force
       apply force
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     apply (simp add: pre_split_face_def)
    (* c ∉ set (rev vs) *)
    apply (case_tac "c  set (between (vertices f) ram2 ram1)")
     apply (subgoal_tac "distinct (between (vertices f) ram2 ram1)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac zs) apply simp apply (subgoal_tac "ram2 # ys = as") apply force
       apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
      apply simp
      apply (subgoal_tac "ram2 # ys = as") apply (simp add: Edges_def is_sublist_def)
       apply (subgoal_tac "(ram2 # ys) @ c # a # list @ ram1 # vs = as @ c # d # bs")
        apply (thin_tac "ram2 # ys @ c # a # list @ ram1 # vs = as @ c # d # bs")
        apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply force
        apply (rule impI) apply (rule disjI2)+ apply force
       apply force
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     apply (subgoal_tac "distinct (vertices f21)")
     apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs = as @ c # d # bs") apply simp
     apply (rule dist_f21)
      (* c ∉  set (between (vertices f) ram2 ram1) *)
    apply (subgoal_tac "c = ram2") apply simp
     apply (subgoal_tac "[] = as") apply simp apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym)  apply simp apply simp

    (* c ≠ ram2 *)
    apply (subgoal_tac "c  set (ram2 # between (vertices f) ram2 ram1 @ ram1 # vs)")
     apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs = as @ c # d # bs") apply simp
    by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    apply (case_tac "c = ram2  d = hd (between (vertices f) ram2 ram1)") apply simp apply (rule disjI1)
     apply (intro exI) apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs =
       [] @ ram2 # hd (between (vertices f) ram2 ram1) # tl (between (vertices f) ram2 ram1) @ ram1 # vs") apply assumption apply simp
    apply (case_tac "c = ram1  d = hd vs") apply (rule disjI1)
     apply (case_tac "vs")  apply simp
     apply simp apply (intro exI)
     apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # a # list =
        (ram2 # between (vertices f) ram2 ram1) @ ram1 # a # list") apply assumption apply simp
    apply (case_tac "c = last vs  d = ram2")
     apply (case_tac vs rule:rev_exhaust) apply simp
     apply simp
    apply simp
    apply (case_tac "c = last (between (vertices f) ram2 ram1)  d = ram1") apply (rule disjI1)
     apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
     apply (intro exI) apply simp
     apply (subgoal_tac "ram2 # ys @ y # ram1 # vs = (ram2 # ys) @ y # ram1 # vs")
      apply assumption
     apply simp
    apply simp
    apply (case_tac "(c, d)  Edges vs") apply (simp add: Edges_def is_sublist_def)
     apply (elim exE) apply simp apply (rule conjI) apply (rule impI) apply (rule disjI1) apply (intro exI)
      apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # as @ [c, d]
        = (ram2 # between (vertices f) ram2 ram1 @ ram1 # as) @ c # d # []") apply assumption apply simp
     apply (rule impI) apply (rule disjI1) apply (intro exI)
     apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # as @ c # d # bs
        = (ram2 # between (vertices f) ram2 ram1 @ ram1 # as) @ c # d # bs") apply assumption apply simp
    apply (simp add: Edges_def is_sublist_def)
    apply (elim exE) apply simp apply (rule disjI1) apply (intro exI)
    apply (subgoal_tac "ram2 # as @ c # d # bs @ ram1 # vs = (ram2 # as) @ c # d # (bs @ ram1 # vs)")
     apply assumption by simp
qed


lemma split_face_edges_f21_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
              "(f12, f21) = split_face f ram1 ram2 []"
              "vs2 = between (vertices f) ram2 ram1" "vs2  []"
shows "edges f21 = {(last vs2, ram1) , (ram1, ram2), (ram2, hd vs2)} 
                   Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
    apply (case_tac " c = ram1  d = ram2") apply simp apply simp  apply (elim exE)

    apply (case_tac "c = ram1") apply simp
    apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 = as")
    apply (subgoal_tac "(ram2 # between (vertices f) ram2 ram1) @ [ram1]  = as @ ram1 # d # bs")
    apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1]  = as @ ram1 # d # bs")
    apply simp apply force
    apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
    (* a ≠ ram1 *)
    apply (case_tac "c  set (between (vertices f) ram2 ram1)")
    apply (subgoal_tac "distinct (between (vertices f) ram2 ram1)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
    apply (case_tac zs) apply simp apply (subgoal_tac "ram2 # ys = as") apply force
    apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp apply simp
    apply (subgoal_tac "ram2 # ys = as") apply (simp add: Edges_def is_sublist_def)
    apply (subgoal_tac "(ram2 # ys) @ c # a # list @ [ram1] = as @ c # d # bs")
    apply (thin_tac "ram2 # ys @ c # a # list @ [ram1] = as @ c # d # bs")
    apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply force
    apply (rule impI) apply (rule disjI2)+ apply force apply force
    apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
    apply (subgoal_tac "distinct (vertices f21)")
    apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ c # d # bs") apply simp
    apply (rule dist_f21)
      (* c ∉  set (between (vertices f) ram2 ram1) *)
    apply (subgoal_tac "c = ram2") apply simp
    apply (subgoal_tac "[] = as") apply simp apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
    apply (rule dist_at1) apply (rule dist_f21) apply (rule sym)  apply simp apply simp

    (* c ≠ ram2 *)
    apply (subgoal_tac "c  set (ram2 # between (vertices f) ram2 ram1 @ [ram1])")
    apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ c # d # bs") apply simp
    by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    apply (case_tac "c = ram2  d = hd (between (vertices f) ram2 ram1)") apply simp apply (rule disjI1)
    apply (intro exI) apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] =
       [] @ ram2 # hd (between (vertices f) ram2 ram1) # tl (between (vertices f) ram2 ram1) @ [ram1]") apply assumption apply simp
    apply (case_tac "c = ram1  d = ram2") apply (rule disjI2) apply simp apply simp
    apply (case_tac "c = last (between (vertices f) ram2 ram1)  d = ram1") apply (rule disjI1)
      apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
      apply (intro exI) apply simp
      apply (subgoal_tac "ram2 # ys @ y # [ram1] = (ram2 # ys) @ y # [ram1]")
      apply assumption apply simp apply simp
    apply (simp add: Edges_def is_sublist_def)
      apply (elim exE) apply simp apply (rule disjI1) apply (intro exI)
      apply (subgoal_tac "ram2 # as @ c # d # bs @ [ram1] = (ram2 # as) @ c # d # (bs @ [ram1])")
      apply assumption by simp
qed


lemma split_face_edges_f21_bet:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "(f12, f21) = split_face f ram1 ram2 vs"
              "vs  []" "between (vertices f) ram2 ram1 = []"
shows "edges f21 = {(ram1, hd vs), (last vs, ram2), (ram2, ram1)} 
                   Edges vs" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
    apply (case_tac " c = last vs  d = ram2") apply simp
    apply simp apply (elim exE)
    apply (case_tac "c = ram1") apply simp
     apply (subgoal_tac "[ram2] = as") apply clarsimp
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
    (* a ≠ ram1 *)
    apply (case_tac "c  set vs")
     apply (subgoal_tac "distinct vs") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
      apply (case_tac "zs") apply simp
       apply (subgoal_tac "ram2 #  ram1 # ys = as") apply force
       apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
      apply simp
      apply (subgoal_tac "ram2 # ram1 # ys = as")
       apply (subgoal_tac "(ram2 # ram1 # ys) @ c # a # list = as @ c # d # bs")
        apply (thin_tac "ram2 #  ram1 # ys @ c # a # list = as @ c # d # bs")
        apply (simp add: Edges_def is_sublist_def) apply force
       apply force
      apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
     apply (simp add: pre_split_face_def)
    (* c ∉ set (rev vs) *)
    apply (subgoal_tac "c = ram2") apply simp
     apply (subgoal_tac "[] = as") apply simp
     apply (rule dist_at1) apply (rule dist_f21) apply (rule sym)  apply simp apply simp
    (* c ≠ ram2 *)
    apply (subgoal_tac "c  set (ram2 # ram1 # vs)")
     apply (thin_tac "ram2 # ram1 # vs = as @ c # d # bs") apply simp
    by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    apply (case_tac "c = ram2  d = ram1") apply simp apply (rule disjI1) apply force
    apply (case_tac "c = ram1  d = hd vs") apply (rule disjI1)
     apply (case_tac "vs")  apply simp
     apply simp apply (intro exI)
     apply (subgoal_tac "ram2 # ram1 # a # list =
        [ram2] @ ram1 # a # list") apply assumption  apply simp
    apply (case_tac "c = last vs  d = ram2")
     apply (case_tac vs rule: rev_exhaust) apply simp
     apply simp
    apply (simp add: Edges_def is_sublist_def)
    apply (elim exE) apply simp apply (rule conjI) apply (rule impI) apply (rule disjI1) apply (intro exI)
     apply (subgoal_tac "ram2 # ram1 # as @ [c, d]
        = (ram2 # ram1 # as) @ c # d # []") apply assumption apply simp
    apply (rule impI) apply (rule disjI1) apply (intro exI)
    apply (subgoal_tac "ram2 #  ram1 # as @ c # d # bs
        = (ram2 # ram1 # as) @ c # d # bs") apply assumption by simp
qed


lemma split_face_edges_f21_bet_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
              "(f12, f21) = split_face f ram1 ram2 []"
              "between (vertices f) ram2 ram1 = []"
shows "edges f21 = {(ram1, ram2), (ram2, ram1)}" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?rhs"
    apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
    apply (case_tac " c = ram1  d = ram2") apply simp  apply simp apply (elim exE)
    apply (case_tac "as") apply  simp  apply (case_tac "list") by auto
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
  from x vors show "x  ?lhs"
    apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
    by auto
qed

lemma split_face_edges_f21_subset: "pre_split_face f ram1 ram2 vs 
  (f12, f21) = split_face f ram1 ram2 vs  vs  [] 
  {(last vs, ram2), (ram1, hd vs)}  Edges vs  edges f21"
  apply (case_tac "between (vertices f) ram2 ram1")
    apply (frule split_face_edges_f21_bet)  apply simp apply simp apply simp apply force
    apply (frule split_face_edges_f21) apply simp+ by force

lemma verticesFrom_ram1: "pre_split_face f ram1 ram2 vs 
  verticesFrom f ram1 = ram1 # between (vertices f) ram1 ram2 @ ram2 # between (vertices f) ram2 ram1"
  apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
  apply (subgoal_tac "distinct (vertices f)")
  apply (case_tac "before (vertices f) ram1 ram2")
  apply (simp add: verticesFrom_Def)
  apply (subgoal_tac "ram2  set (snd (splitAt ram1 (vertices f)))") apply (drule splitAt_ram)
  apply (subgoal_tac "snd (splitAt ram2 (snd (splitAt ram1 (vertices f)))) = snd (splitAt ram2 (vertices f))")
  apply simp apply (thin_tac "snd (splitAt ram1 (vertices f)) =
     fst (splitAt ram2 (snd (splitAt ram1 (vertices f)))) @
     ram2 # snd (splitAt ram2 (snd (splitAt ram1 (vertices f))))")  apply simp
  apply (rule before_dist_r2) apply simp apply simp
  apply (subgoal_tac "before (vertices f) ram2 ram1")
  apply (subgoal_tac "pre_between (vertices f) ram2 ram1")
  apply (simp add: verticesFrom_Def)
  apply (subgoal_tac "ram2  set (fst (splitAt ram1 (vertices f)))") apply (drule splitAt_ram)
  apply (subgoal_tac "fst (splitAt ram2 (fst (splitAt ram1 (vertices f)))) = fst (splitAt ram2 (vertices f))")
  apply simp apply (thin_tac "fst (splitAt ram1 (vertices f)) =
     fst (splitAt ram2 (fst (splitAt ram1 (vertices f)))) @
     ram2 # snd (splitAt ram2 (fst (splitAt ram1 (vertices f))))") apply simp
  apply (rule before_dist_r1) apply simp apply simp apply (simp add: pre_between_def) apply force
  apply (simp add: pre_split_face_def) by (rule pre_split_face_p_between)

lemma split_face_edges_f_vs1_vs2:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "between (vertices f) ram1 ram2 = []"
              "between (vertices f) ram2 ram1 = []"
shows "edges f = {(ram2, ram1) , (ram1, ram2)}" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from x vors show "x  ?rhs" apply (simp add: dist_f)
    apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
     apply (drule is_nextElem_or) apply assumption
     apply (simp add: Edges_def)
     apply (case_tac "is_sublist [c, d] [ram1, ram2]") apply (simp)
     apply (simp) apply blast
    by (rule pre_split_face_p_between)
  next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from x vors show "x  ?lhs" apply (simp add: dist_f)
    apply (subgoal_tac "ram1  𝒱 f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
    apply (simp add: is_nextElem_def) apply blast
    by (simp add: pre_split_face_def)
qed

lemma split_face_edges_f_vs1:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "between (vertices f) ram1 ram2 = []"
              "vs2 = between (vertices f) ram2 ram1" "vs2  []"
shows "edges f = {(last vs2, ram1) , (ram1, ram2), (ram2, hd vs2)} 
                 Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
  from x vors show "x  ?rhs" apply (simp add: dist_f)
    apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
     apply (drule is_nextElem_or) apply assumption
     apply (simp add: Edges_def)
     apply (case_tac "is_sublist [c, d] [ram1, ram2]")
      apply simp
     apply simp
     apply(erule disjE) apply blast
     apply (case_tac "c = ram2")
      apply (case_tac "between (vertices f) ram2 ram1") apply simp
      apply simp
      apply (drule is_sublist_distinct_prefix)
       apply (subgoal_tac "distinct (ram2 # vs2 @ [ram1])")
        apply simp
       apply (rule dist_vs2)
      apply simp
     apply (case_tac "c = ram1")
      apply (subgoal_tac "¬ is_sublist [c, d] (ram2 # vs2 @ [ram1])")
       apply simp
      apply (rule is_sublist_notlast)
       apply (rule_tac dist_vs2)
      apply simp
     apply simp
     apply (simp add: is_sublist_def)
     apply (elim exE)
     apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
     apply simp
     apply (case_tac "bs" rule: rev_exhaust) apply simp
     apply simp
     apply (rule disjI2)
     apply (intro exI)
     apply simp
    apply (rule pre_split_face_p_between) by simp
  next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f)
    apply (subgoal_tac "ram1  set (vertices f)") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
    apply (simp add: is_nextElem_def)
    apply (case_tac "c = last (between (vertices f) ram2 ram1)  d = ram1") apply simp apply simp apply (rule disjI1)
    apply (case_tac "c = ram1  d = ram2")  apply (simp add: is_sublist_def) apply force apply simp
    apply (case_tac "c = ram2  d = hd (between (vertices f) ram2 ram1)")
      apply (case_tac "between (vertices f) ram2 ram1") apply simp apply (simp add: is_sublist_def) apply (intro exI)
      apply (subgoal_tac "ram1 # ram2 # a # list =
        [ram1] @ ram2 # a # (list)") apply assumption apply simp
    apply simp
      apply (subgoal_tac "is_sublist [c, d] ((ram1 #
                        [ram2]) @ between (vertices f) ram2 ram1 @ [])")
      apply simp apply (rule is_sublist_add) apply (simp add: Edges_def)
    by (simp add: pre_split_face_def)
qed


lemma split_face_edges_f_vs2:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "vs1 = between (vertices f) ram1 ram2" "vs1  []"
              "between (vertices f) ram2 ram1 = []"
shows "edges f = {(ram2, ram1) , (ram1, hd vs1), (last vs1, ram2)} 
                 Edges vs1" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
  from x vors show "x  ?rhs" apply (simp add: dist_f)
    apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
     apply (drule is_nextElem_or) apply assumption
     apply (simp add: Edges_def)
     apply (case_tac "is_sublist [c, d] (ram1 # between (vertices f) ram1 ram2 @ [ram2])")
      apply simp
      apply (case_tac "c = ram1")
       apply (case_tac "between (vertices f) ram1 ram2") apply simp
       apply simp
       apply (drule is_sublist_distinct_prefix)
        apply (subgoal_tac "distinct (ram1 # vs1 @ [ram2])") apply simp
        apply (rule dist_vs1)
       apply simp
      apply (case_tac "c = ram2")
       apply (subgoal_tac "¬ is_sublist [c, d] (ram1 # vs1 @ [ram2])") apply simp
       apply (rule is_sublist_notlast) apply (rule_tac dist_vs1)
       apply simp
      apply simp
      apply (simp add: is_sublist_def)
      apply (elim exE)
      apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
      apply simp
      apply (case_tac "bs" rule: rev_exhaust) apply simp
      apply simp
      apply (rule disjI2)
      apply (intro exI)
      apply simp
     apply simp
    apply (rule pre_split_face_p_between) by simp
  next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
  from x vors show "x  ?lhs"
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f)
    apply (subgoal_tac "ram1  𝒱 f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
    apply (simp add: is_nextElem_def)
    apply (case_tac "c = ram2  d = ram1") apply simp apply simp apply (rule disjI1)
    apply (case_tac "c = ram1  d = hd (between (vertices f) ram1 ram2)")
      apply (case_tac "between (vertices f) ram1 ram2") apply simp apply (force simp: is_sublist_def) apply simp
    apply (case_tac "c = last (between (vertices f) ram1 ram2)  d = ram2")
      apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply (simp add: is_sublist_def)
      apply (intro exI)
      apply (subgoal_tac "ram1 # ys @ [y, ram2] =
        (ram1 # ys) @ y # ram2 # []") apply assumption apply simp
    apply simp
      apply (simp add: Edges_def)
      apply (subgoal_tac "is_sublist [c, d] ([ram1] @ between (vertices f) ram1 ram2 @ [ram2])")
      apply simp apply (rule is_sublist_add) apply simp
    by (simp add: pre_split_face_def)
qed


lemma split_face_edges_f:
assumes vors: "pre_split_face f ram1 ram2 vs"
              "vs1 = between (vertices f) ram1 ram2" "vs1  []"
              "vs2 = between (vertices f) ram2 ram1" "vs2  []"
shows "edges f = {(last vs2, ram1) , (ram1, hd vs1), (last vs1, ram2), (ram2, hd vs2)} 
                 Edges vs1  Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
  fix x
  assume x: "x  ?lhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
  from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
  from x vors show "x  ?rhs" apply (simp add: dist_f)
    apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
    apply (drule is_nextElem_or) apply assumption apply (simp add: Edges_def)
    apply (case_tac "is_sublist [c, d] (ram1 # between (vertices f) ram1 ram2 @ [ram2])") apply simp
      apply (case_tac "c = ram1")
        apply (case_tac "between (vertices f) ram1 ram2") apply simp apply simp
        apply (drule is_sublist_distinct_prefix) apply (subgoal_tac "distinct (ram1 # vs1 @ [ram2])")
        apply simp apply (rule dist_vs1) apply simp
      apply (case_tac "c = ram2")
        apply (subgoal_tac "¬ is_sublist [c, d] (ram1 # vs1 @ [ram2])") apply simp
        apply (rule is_sublist_notlast) apply (rule_tac dist_vs1) apply simp
      apply simp apply (simp add: is_sublist_def) apply (elim exE)
        apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply simp
        apply (case_tac "bs" rule: rev_exhaust) apply simp apply simp
        apply (rule disjI2) apply (rule disjI2) apply (rule disjI1) apply (intro exI) apply simp
    apply simp
      apply (case_tac "c = ram2")
        apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
        apply (drule is_sublist_distinct_prefix) apply (subgoal_tac "distinct (ram2 # vs2 @ [ram1])")
        apply simp apply (rule dist_vs2) apply simp
      apply (case_tac "c = ram1")
        apply (subgoal_tac "¬ is_sublist [c, d] (ram2 # vs2 @ [ram1])") apply simp
        apply (rule is_sublist_notlast) apply (rule_tac dist_vs2) apply simp
      apply simp apply (simp add: is_sublist_def) apply (elim exE)
        apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp apply simp
        apply (case_tac "bs" rule: rev_exhaust) apply simp apply simp
        apply (rule disjI2) apply (rule disjI2) apply (rule disjI2) apply (intro exI) apply simp
   apply (rule pre_split_face_p_between) by simp
next
  fix x
  assume x: "x  ?rhs"
  define c where "c = fst x"
  define d where "d = snd x"
  with c_def  have [simp]: "x = (c,d)" by simp
  from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
  from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
  from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
    apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
  from x vors show "x  ?lhs" 
    supply [[simproc del: defined_all]]
    apply (simp add: dist_f)
    apply (subgoal_tac "ram1  𝒱 f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
    apply (simp add: is_nextElem_def)
    apply (case_tac "c = last (between (vertices f) ram2 ram1)  d = ram1") apply simp apply simp apply (rule disjI1)
    apply (case_tac "c = ram1  d = hd (between (vertices f) ram1 ram2)")
      apply (case_tac "between (vertices f) ram1 ram2") apply simp apply (force simp: is_sublist_def) apply simp
    apply (case_tac "c = last (between (vertices f) ram1 ram2)  d = ram2")
      apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply (simp add: is_sublist_def)
      apply (intro exI)
      apply (subgoal_tac "ram1 # ys @ y # ram2 # between (vertices f) ram2 ram1 =
        (ram1 # ys) @ y # ram2 # (between (vertices f) ram2 ram1)") apply assumption apply simp apply simp
    apply (case_tac "c = ram2  d = hd (between (vertices f) ram2 ram1)")
      apply (case_tac "between (vertices f) ram2 ram1") apply simp apply (simp add: is_sublist_def) apply (intro exI)
      apply (subgoal_tac "ram1 # between (vertices f) ram1 ram2 @ ram2 # a # list =
        (ram1 # between (vertices f) ram1 ram2) @ ram2 # a # (list)") apply assumption apply simp apply simp
    apply (case_tac "(c, d)  Edges (between (vertices f) ram1 ram2)") apply (simp add: Edges_def)
      apply (subgoal_tac "is_sublist [c, d] ([ram1] @ between (vertices f) ram1 ram2 @
                        (ram2 # between (vertices f) ram2 ram1))")
      apply simp apply (rule is_sublist_add) apply simp
    apply simp
      apply (subgoal_tac "is_sublist [c, d] ((ram1 # between (vertices f) ram1 ram2 @
                        [ram2]) @ between (vertices f) ram2 ram1 @ [])")
      apply simp apply (rule is_sublist_add) apply (simp add: Edges_def)
    by (simp add: pre_split_face_def)
qed


lemma split_face_edges_f12_f21:
  "pre_split_face f ram1 ram2 vs  (f12, f21) = split_face f ram1 ram2 vs 
   vs  []
   edges f12  edges f21 = edges f 
     {(hd vs, ram1), (ram1, hd vs), (last vs, ram2), (ram2, last vs)} 
     Edges vs 
     Edges (rev vs)"
  apply (case_tac "between (vertices f) ram1 ram2 = []")
    apply (case_tac "between (vertices f) ram2 ram1 = []")
      apply (simp add: split_face_edges_f12_bet split_face_edges_f21_bet split_face_edges_f_vs1_vs2)
      apply force
    apply (simp add: split_face_edges_f12_bet split_face_edges_f21 split_face_edges_f_vs1) apply force
  apply (case_tac "between (vertices f) ram2 ram1 = []")
    apply (simp add: split_face_edges_f21_bet split_face_edges_f12 split_face_edges_f_vs2) apply force
  apply (simp add: split_face_edges_f21 split_face_edges_f12 split_face_edges_f) by force


lemma split_face_edges_f12_f21_vs:
  "pre_split_face f ram1 ram2 []  (f12, f21) = split_face f ram1 ram2 []
   edges f12  edges f21 = edges f 
     {(ram2, ram1), (ram1, ram2)}"
  apply (case_tac "between (vertices f) ram1 ram2 = []")
    apply (case_tac "between (vertices f) ram2 ram1 = []")
      apply (simp add: split_face_edges_f12_bet_vs split_face_edges_f21_bet_vs split_face_edges_f_vs1_vs2)
      apply force
    apply (simp add: split_face_edges_f12_bet_vs split_face_edges_f21_vs split_face_edges_f_vs1) apply force
  apply (case_tac "between (vertices f) ram2 ram1 = []")
    apply (simp add: split_face_edges_f21_bet_vs split_face_edges_f12_vs split_face_edges_f_vs2) apply force
  apply (simp add: split_face_edges_f21_vs split_face_edges_f12_vs split_face_edges_f) by force


lemma split_face_edges_f12_f21_sym:
  "f   g 
  pre_split_face f ram1 ram2 vs  (f12, f21) = split_face f ram1 ram2 vs
   ((a,b)  edges f12  (a,b)   edges f21) =
     ((a,b)  edges f  
  (((b,a)  edges f12  (b,a)   edges f21) 
  ((a,b)  edges f12  (a,b)  edges f21)))"
  apply (subgoal_tac "((a,b)  edges f12  edges f21) =
     ((a,b)  edges f  ((b,a)  edges f12  edges f21)  (a,b)  edges f12  edges f21)") apply force
  apply (case_tac "vs = []")
    apply (subgoal_tac "pre_split_face f ram1 ram2 []")
    apply (drule split_face_edges_f12_f21_vs) apply simp apply simp apply force apply simp
  apply (drule split_face_edges_f12_f21) apply simp apply simp
    apply simp by force

lemma splitFace_edges_g'_help: "pre_splitFace g ram1 ram2 f vs 
  (f12, f21, g') = splitFace g ram1 ram2 f vs  vs  [] 
  edges g' = edges g  edges f  Edges vs  Edges(rev vs) 
  {(ram2, last vs), (hd vs, ram1), (ram1, hd vs), (last vs, ram2)}"
proof -
  assume pre: "pre_splitFace g ram1 ram2 f vs"
    and fdg: "(f12, f21, g') = splitFace g ram1 ram2 f vs"
    and vs_neq: "vs  []"

  from pre fdg have split: "(f12, f21) = split_face f ram1 ram2 vs"
    apply (unfold pre_splitFace_def) apply (elim conjE)
    by (simp add: splitFace_split_face)

  from fdg pre have "edges g' = (aset (replace f [f21] (faces g)) edges a) 
       edges (f12)" by(auto simp: splitFace_def split_def edges_graph_def)
  with pre vs_neq show ?thesis apply (simp add: UNION_eq) apply (rule equalityI) apply simp
    apply (rule conjI) apply (rule subsetI) apply simp apply (erule bexE) apply (drule replace5)
    apply (case_tac "xa   g") apply simp
    apply (subgoal_tac "x  edges g") apply simp
    apply (simp add: edges_graph_def) apply force
    apply simp
    apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
    apply (case_tac "between (vertices f) ram2 ram1 = []")
      apply (frule split_face_edges_f21_bet) apply (rule split) apply simp apply simp
      apply (case_tac "between (vertices f) ram1 ram2 = []")
        apply (frule split_face_edges_f_vs1_vs2) apply simp apply simp apply simp apply force
        apply (frule split_face_edges_f_vs2) apply simp apply simp apply simp apply force
    apply (frule split_face_edges_f21) apply (rule split) apply simp apply simp apply simp
      apply (case_tac "between (vertices f) ram1 ram2 = []")
        apply (frule split_face_edges_f_vs1) apply simp apply simp apply simp apply simp apply force
        apply (frule split_face_edges_f) apply simp apply simp apply simp apply simp apply force
    apply simp
    apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
    apply (case_tac "between (vertices f) ram1 ram2 = []")
      apply (frule split_face_edges_f12_bet) apply (rule split) apply simp apply simp
      apply (case_tac "between (vertices f) ram2 ram1 = []")
        apply (frule split_face_edges_f_vs1_vs2) apply simp apply simp apply simp apply force
        apply (frule split_face_edges_f_vs1) apply simp apply simp apply simp apply force
    apply (frule split_face_edges_f12) apply (rule split) apply simp apply simp apply simp
      apply (case_tac "between (vertices f) ram2 ram1 = []")
        apply (frule split_face_edges_f_vs2) apply simp apply simp apply simp apply simp apply force
        apply (frule split_face_edges_f) apply simp apply simp apply simp apply simp apply force
    apply simp
    apply simp
    apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
    apply (subgoal_tac "(ram2, last vs)  edges f12  (hd vs, ram1)  edges f12")
      apply (rule conjI) apply simp
      apply (rule conjI) apply simp
    apply (subgoal_tac "(ram1, hd vs)  edges f21  (last vs, ram2)  edges f21")
      apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply (elim conjE) apply simp
        apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp
      apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply (elim conjE) apply simp
        apply (rule replace3) apply(erule pre_splitFace_oldF)
    apply simp
    apply (subgoal_tac "edges f  {y. xset (replace f [f21] (faces g)). y  edges x}  edges f12")
    apply (subgoal_tac "edges g  {y. xset (replace f [f21] (faces g)). y  edges x}  edges f12")
      apply (rule conjI) apply simp
      apply (rule conjI) apply simp
    apply (subgoal_tac "Edges(rev vs)  edges f12") apply (rule conjI) prefer 2 apply blast
    apply (subgoal_tac "Edges vs  edges f21")
      apply (subgoal_tac "Edges vs  {y. xset (replace f [f21] (faces g)). y  edges x}") apply blast
      apply (rule subset_trans) apply  assumption apply (rule subsetI) apply simp apply (rule bexI) apply simp
      apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp
    (* jetzt alle 7 subgoals aufloesen *)
    apply (frule split_face_edges_f21_subset) apply (rule split)  apply simp apply simp
    apply (frule split_face_edges_f12_subset) apply (rule split) apply simp apply simp
    apply (simp add: edges_graph_def)  apply (rule subsetI) apply simp apply (elim bexE)
      apply (case_tac "xa = f") apply simp apply blast
      apply (rule disjI1) apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
    apply (rule subsetI)
      apply (subgoal_tac " u v. x = (u,v)") apply (elim exE conjE)
      apply (frule split_face_edges_or [OF split]) apply simp
      apply (case_tac "(u, v)  edges f12") apply simp apply simp
      apply (rule bexI) apply (thin_tac "(u, v)  edges f")  apply assumption
      apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp apply simp
    apply (frule split_face_edges_f21_subset) apply (rule split) apply simp apply simp
    apply (frule split_face_edges_f12_subset) apply (rule split) apply simp apply simp
  by simp
qed

lemma pre_splitFace_edges_f_in_g: "pre_splitFace g ram1 ram2 f vs  edges f  edges g"
  apply (simp add: edges_graph_def) by (force)

lemma pre_splitFace_edges_f_in_g2: "pre_splitFace g ram1 ram2 f vs  x  edges f  x  edges g"
  apply (simp add: edges_graph_def) by (force)

lemma splitFace_edges_g': "pre_splitFace g ram1 ram2 f vs 
  (f12, f21, g') = splitFace g ram1 ram2 f vs  vs  [] 
  edges g' = edges g  Edges vs  Edges(rev vs) 
  {(ram2, last vs), (hd vs, ram1), (ram1, hd vs), (last vs, ram2)}"
  apply (subgoal_tac "edges g  edges f = edges g")
  apply (frule splitFace_edges_g'_help) apply simp apply simp apply simp
  apply (frule pre_splitFace_edges_f_in_g) by blast


lemma splitFace_edges_g'_vs: "pre_splitFace g ram1 ram2 f [] 
  (f12, f21, g') = splitFace g ram1 ram2 f []  
  edges g' = edges g  {(ram1, ram2), (ram2, ram1)}"
proof -
  assume pre: "pre_splitFace g ram1 ram2 f []"
    and fdg: "(f12, f21, g') = splitFace g ram1 ram2 f []"

  from pre fdg have split: "(f12, f21) = split_face f ram1 ram2 []"
    apply (unfold pre_splitFace_def) apply (elim conjE)
    by (simp add: splitFace_split_face)

  from fdg pre have "edges g' = (aset (replace f [f21] (faces g)) edges a) 
       edges (f12)" by (auto simp: splitFace_def split_def edges_graph_def)
  with pre show ?thesis apply (simp add: UNION_eq) apply (rule equalityI) apply simp
    apply (rule conjI) apply (rule subsetI) apply simp apply (erule bexE) apply (drule replace5)
    apply (case_tac "xa   g") apply simp
    apply (subgoal_tac "x  edges g") apply simp
    apply (simp add: edges_graph_def) apply force
    apply simp
    apply (subgoal_tac "pre_split_face f ram1 ram2 []")
    apply (case_tac "between (vertices f) ram2 ram1 = []") apply (simp add: pre_FaceDiv_between2)
      apply (frule split_face_edges_f21_vs) apply (rule split) apply simp apply simp apply simp
      apply (case_tac "x = (ram1, ram2)") apply simp apply simp apply (rule disjI2)
      apply (rule pre_splitFace_edges_f_in_g2)  apply simp
      apply (subgoal_tac "pre_split_face f ram1 ram2 []")
      apply (frule split_face_edges_f) apply simp apply simp apply (rule pre_FaceDiv_between1) apply simp apply simp
      apply simp apply force  apply simp apply simp

    apply (rule subsetI) apply simp
    apply (subgoal_tac "pre_split_face f ram1 ram2 []")
    apply (case_tac "between (vertices f) ram1 ram2 = []") apply (simp add: pre_FaceDiv_between1)
      apply (frule split_face_edges_f12_vs) apply (rule split) apply simp apply simp apply simp
      apply (case_tac "x = (ram2, ram1)") apply simp apply simp apply (rule disjI2)
      apply (rule pre_splitFace_edges_f_in_g2)  apply simp
      apply (subgoal_tac "pre_split_face f ram1 ram2 []")
      apply (frule split_face_edges_f) apply simp apply simp apply simp apply (rule pre_FaceDiv_between2) apply simp
      apply simp apply force apply simp apply simp
   apply simp
   apply (subgoal_tac "pre_split_face f ram1 ram2 []")
   apply (subgoal_tac "(ram1, ram2)  edges f21")
   apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply simp apply (force)
   apply (subgoal_tac "(ram2, ram1)  edges f12")
   apply (rule conjI) apply force
   apply (rule subsetI) apply (simp add: edges_graph_def) apply (elim bexE)
     apply (case_tac "xa = f") apply simp
     apply (subgoal_tac " u v. x = (u,v)") apply (elim exE conjE)
     apply (subgoal_tac "pre_split_face f ram1 ram2 []")
     apply (frule split_face_edges_or [OF split]) apply simp
     apply (case_tac "(u, v)  edges f12") apply simp apply simp apply force apply simp  apply simp
     apply (rule disjI1) apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
   apply (frule split_face_edges_f12_vs) apply simp apply (rule split) apply simp
     apply (rule pre_FaceDiv_between1) apply simp apply simp
   apply (frule split_face_edges_f21_vs) apply simp apply (rule split) apply simp
     apply (rule pre_FaceDiv_between2) apply simp apply simp
   by simp
qed


lemma splitFace_edges_incr:
 "pre_splitFace g ram1 ram2 f vs 
  (f1, f2, g') = splitFace g ram1 ram2 f vs  
  edges g  edges g'"
apply(cases vs)
 apply(simp add:splitFace_edges_g'_vs)
 apply blast
apply(simp add:splitFace_edges_g')
apply blast
done

lemma snd_snd_splitFace_edges_incr:
 "pre_splitFace g v1 v2 f vs 
  edges g  edges(snd(snd(splitFace g v1 v2 f vs)))"
apply(erule splitFace_edges_incr
 [where f1 = "fst(splitFace g v1 v2 f vs)"
  and f2 = "fst(snd(splitFace g v1 v2 f vs))"])
apply(auto)
done


(********************* Vorbereitung für subdivFace *****************)

(**** computes the list of ram vertices **********)
subsection removeNones›

definition removeNones :: "'a option list  'a list" where
"removeNones vOptionList  [the x. x  vOptionList, x  None]"

(* "removeNones vOptionList ≡ map the [x ∈ vOptionList. x ≠ None]" *)

declare  removeNones_def [simp]
lemma removeNones_inI[intro]: "Some a  set ls  a  set (removeNones ls)" by (induct ls)  auto
lemma removeNones_hd[simp]: "removeNones ( Some a # ls) = a # removeNones ls" by auto
lemma removeNones_last[simp]: "removeNones (ls @ [Some a]) = removeNones ls @ [a]" by auto
lemma removeNones_in[simp]: "removeNones (as @ Some a # bs) = removeNones as @ a # removeNones bs" by auto
lemma removeNones_none_hd[simp]: "removeNones ( None # ls) = removeNones ls" by auto
lemma removeNones_none_last[simp]: "removeNones (ls @ [None]) = removeNones ls" by auto
lemma removeNones_none_in[simp]: "removeNones (as @ None # bs) = removeNones (as @ bs)" by auto
lemma removeNones_empty[simp]: "removeNones [] = []" by auto
declare removeNones_def [simp del]





(************* natToVertexList ************)
subsectionnatToVertexList›

(* Hilfskonstrukt natToVertexList *)
primrec natToVertexListRec ::
  "nat  vertex  face  nat list  vertex option list"
where
  "natToVertexListRec old v f [] = []" |
  "natToVertexListRec old v f (i#is) =
    (if i = old then None#natToVertexListRec i v f is
     else Some (fi  v)
          # natToVertexListRec i v f is)"

primrec natToVertexList ::
  "vertex  face  nat list  vertex option list"
where
  "natToVertexList v f [] = []" |
  "natToVertexList v f (i#is) =
    (if i = 0 then (Some v)#(natToVertexListRec i v f is) else [])"


subsection @{const indexToVertexList}

lemma  nextVertex_inj:
 "distinct (vertices f)  v  𝒱 f 
 i < length (vertices (f::face))  a < length (vertices f) 
 fav = fiv  i = a"
proof -
  assume d: "distinct (vertices f)" and v: "v  𝒱 f" and i: "i < length (vertices (f::face))"
    and a: "a < length (vertices f)" and eq:" fav = fiv"
  then have eq: "(verticesFrom f v)!a = (verticesFrom f v)!i " by (simp add: verticesFrom_nth)
  define xs where "xs = verticesFrom f v"
  with eq have eq: "xs!a = xs!i" by auto
  from d v have z: "distinct (verticesFrom f v)" by auto
  moreover
  from xs_def a v d have "(verticesFrom f v) = take a xs @ xs ! a # drop (Suc a) xs"
    by (auto intro: id_take_nth_drop simp: verticesFrom_length)
  with eq have "(verticesFrom f v) = take a xs @ xs ! i # drop (Suc a) xs" by simp
  moreover
  from xs_def i v d have "(verticesFrom f v) = take i xs @ xs ! i # drop (Suc i) xs"
    by (auto intro: id_take_nth_drop simp: verticesFrom_length)
  ultimately have "take a xs = take i xs" by (rule dist_at1)
  moreover
  from v d have vertFrom[simp]: "length (vertices f) = length (verticesFrom f v)"
    by (auto simp: verticesFrom_length)
  from xs_def a i have "a < length xs" "i < length xs" by auto
  moreover
  have " a i. a < length xs  i < length xs  take a xs = take i xs  a = i"
  proof (induct xs)
    case Nil then show ?case by auto
  next
    case (Cons x xs) then show ?case
      apply (cases a) apply auto
      apply (cases i) apply auto
      apply (cases i) by auto
  qed
  ultimately show ?thesis by simp
qed

lemma a: "distinct (vertices f)  v  𝒱 f  (i  set is. i < length (vertices f)) 
 (a. a < length (vertices f)  hideDupsRec ((f  ^^ a) v) [(f  ^^ k) v. k  is] = natToVertexListRec a v f is)"
proof (induct "is")
  case Nil then show ?case by simp
next
  case (Cons i "is") then show ?case
   by (auto simp: nextVertices_def intro: nextVertex_inj)
qed

lemma indexToVertexList_natToVertexList_eq: "distinct (vertices f)  v  𝒱 f 
  (i  set is. i < length (vertices f))  is  [] 
 hd is = 0  indexToVertexList f v is = natToVertexList v f is"
apply (cases "is") by (auto simp: a [where a = 0, simplified] indexToVertexList_def nextVertices_def)



(********************* Einschub Ende ***************************************)


(******** natToVertexListRec ************)

lemma nvlr_length: " old.  (length (natToVertexListRec old v f ls)) = length ls"
apply (induct ls) by auto

lemma nvl_length[simp]: "hd e = 0  length (natToVertexList v f e) = length e"
apply (cases "e")
by (auto intro: nvlr_length)


lemma natToVertexListRec_length[simp]: " e f. length (natToVertexListRec e v f es) = length es"
by (induct es) auto

lemma natToVertexList_length[simp]: "incrIndexList es (length es) (length (vertices f)) 
length (natToVertexList v f es) = length es" apply (case_tac es) by simp_all


lemma  natToVertexList_nth_Suc: "incrIndexList es (length es) (length (vertices f))  Suc n < length es 
(natToVertexList v f es)!(Suc n) = (if (es!n = es!(Suc n)) then None else Some (f(es!Suc n)  v))"
proof -
  assume incr: "incrIndexList es (length es) (length (vertices f))" and n: "Suc n < length es"
  have rec: " old n. Suc n < length es 
    (natToVertexListRec old v f es)!(Suc n) = (if (es!n = es!(Suc n)) then None else Some (f(es!Suc n)  v))"
  proof (induct es)
    case Nil then show ?case by auto
  next
    case (Cons e es)
    note cons1 = this
    then show ?case
    proof (cases es)
      case Nil with cons1 show ?thesis by simp
    next
      case (Cons e' es')
      with cons1 show ?thesis
      proof (cases n)
        case 0 with Cons cons1 show ?thesis by simp
      next
        case (Suc m) with Cons cons1
        have " old. natToVertexListRec old v f es ! Suc m = (if es ! m = es ! Suc m then None else Some (fes ! Suc m  v))"
          by (rule_tac cons1) auto
        then show ?thesis apply (cases "e = old") by (simp_all add: Suc)
      qed
    qed
  qed
  with  n have "natToVertexListRec 0 v f es ! Suc n = (if es ! n = es ! Suc n then None else Some (fes ! Suc n  v))" by (rule_tac rec) auto
  with incr show ?thesis by (cases es) auto
qed

lemma  natToVertexList_nth_0: "incrIndexList es (length es) (length (vertices f))  0 < length es 
(natToVertexList v f es)!0 = Some (f(es!0)  v)"
 apply (cases es) 
 apply (simp_all add: nextVertices_def)
 by (subgoal_tac "a = 0")  auto

lemma  natToVertexList_hd[simp]:
  "incrIndexList es (length es) (length (vertices f))  hd (natToVertexList v f es) = Some v"
  apply (cases es) by (simp_all add: nextVertices_def)

lemma nth_last[intro]: "Suc i = length xs   xs!i = last xs"
by (cases xs rule: rev_exhaust)  auto


declare incrIndexList_help4 [simp del]

lemma natToVertexList_last[simp]:
  "distinct (vertices f)  v  𝒱 f  incrIndexList es (length es) (length (vertices f))  last (natToVertexList v f es) = Some (last (verticesFrom f v))"
proof -
  assume vors: "distinct (vertices f)" "v  𝒱 f" and incr: "incrIndexList es (length es) (length (vertices f))"
  define n' where "n' = length es - 2"
  from incr have "1 < length es" by auto
  with n'_def have n'l: "Suc (Suc n') = length es" by arith
  from incr n'l have last_ntvl: "(natToVertexList v f es)!(Suc n') = last (natToVertexList v f es)" by auto
  from n'l have last_es: "es!(Suc n') = last es" by auto
  from n'l  have "es!n' = last (butlast es)" apply (cases es rule: rev_exhaust) by (auto simp: nth_append)
  with last_es incr have less: "es!n' < es!(Suc n')" by auto
  from n'l have "Suc n' < length es" by arith
  with incr less have "(natToVertexList v f es)!(Suc n') = (Some (f(es!Suc n')  v))" by (auto dest: natToVertexList_nth_Suc)
  with incr last_ntvl last_es have rule1: "last (natToVertexList v f es) = Some (f((length (vertices f)) - (Suc 0))  v)" by auto

  from incr have lvf: "1 < length (vertices f)" by auto
  with vors have rule2: "verticesFrom f v ! ((length (vertices f)) - (Suc 0)) = f((length (vertices f)) - (Suc 0))  v" by (auto intro!: verticesFrom_nth)

  from vors lvf have "verticesFrom f v ! ((length (vertices f)) - (Suc 0)) = last (verticesFrom f v)"
    apply (rule_tac nth_last)
    by (auto simp: verticesFrom_length)
  with rule1 rule2 show ?thesis by auto
qed

lemma indexToVertexList_last[simp]:
  "distinct (vertices f)  v  𝒱 f  incrIndexList es (length es) (length (vertices f))  last (indexToVertexList f v es) = Some (last (verticesFrom f v))"
apply (subgoal_tac "indexToVertexList f v es = natToVertexList v f es") apply simp
apply (rule indexToVertexList_natToVertexList_eq) by auto

lemma nths_take: " n iset.  i  iset. i < n  nths (take n xs) iset = nths xs iset"
proof (induct xs)
  case Nil then show ?case by simp
next
  case (Cons x xs) then show ?case apply (simp add: nths_Cons) apply (cases n) apply simp apply (simp add: nths_Cons) apply (rule Cons) by auto
qed


lemma nths_reduceIndices: " iset. nths xs iset = nths xs {i. i < length xs  i  iset}"
proof (induct xs)
  case Nil then show ?case by simp
next
  case (Cons x xs) then
  have "nths xs {j. Suc j  iset} = nths xs {i. i < length xs  i  {j. Suc j  iset}}" by (rule_tac Cons)
  then show ?case by (simp add: nths_Cons)
qed

lemma natToVertexList_nths1: "distinct (vertices f) 
  v  𝒱 f  vs = verticesFrom f v 
  incrIndexList es (length es) (length vs)  n   length es 
  nths (take (Suc (es!(n - 1))) vs) (set (take n es))
  = removeNones (take n (natToVertexList v f es))"
proof (induct n)
  case 0 then show ?case by simp
next
  case (Suc n)
  then have "nths (take (Suc (es ! (n - Suc 0))) (verticesFrom f v)) (set (take n es)) = removeNones (take n (natToVertexList v f es))"
    "distinct (vertices f)" "v  𝒱 f" "vs = verticesFrom f v" "incrIndexList es (length es) (length (verticesFrom f v))" "Suc n  length es" by auto  (* does this improve the performance? *)
  note suc1 = this
  then have lvs: "length vs = length (vertices f)" by (auto intro: verticesFrom_length)
  with suc1 have vsne: "vs  []" by auto
  with suc1 show ?case
  proof (cases "natToVertexList v f es ! n")
    case None then show ?thesis
    proof (cases n)
      case 0 with None suc1 lvs show ?thesis by (simp add: take_Suc_conv_app_nth natToVertexList_nth_0)
    next
      case (Suc n')
      with None suc1 lvs have esn: "es!n = es!n'" by (simp add: natToVertexList_nth_Suc split: if_split_asm)
      from Suc have n': "n - Suc 0 = n'" by auto
      show ?thesis
      proof (cases "Suc n = length es")
        case True then
        have small_n: "n < length es" by auto
        from True have "take (Suc n) es = es" by auto
        with small_n have "take n es @ [es!n] = es" by (simp add: take_Suc_conv_app_nth)
        then have esn_simps: "take n es = butlast es   es!n = last es" by (cases es rule: rev_exhaust) auto

        from True Suc have n'l: "Suc n' = length (butlast es)" by auto
        then have small_n': "n' < length (butlast es)" by auto

        from Suc small_n have take_n': "take (Suc n') (butlast es @ [last es]) = take (Suc n') (butlast es)" by auto
        
        from small_n have es_exh: "es = butlast es @ [last es]" by (cases es rule: rev_exhaust) auto
        
        from n'l have "take (Suc n') (butlast es @ [last es]) = butlast es" by auto
        with es_exh have "take (Suc n') es = butlast es" by auto
        with small_n Suc have "take n' es @ [es!n'] = (butlast es)" by (simp add: take_Suc_conv_app_nth)
        with small_n' have esn'_simps: "take n' es = butlast (butlast es)   es!n' = last (butlast es)"
          by (cases "butlast es" rule: rev_exhaust) auto

        from suc1 have "last (butlast es) < last es" by auto
        with esn esn_simps esn'_simps have False by auto (* have "last (butlast es) = last es" by auto  *)
        then show ?thesis by auto
      next
        case False with suc1 have le: "Suc n < length es" by auto
        from suc1 le have "es = take (Suc n) es @ es!(Suc n) # drop (Suc (Suc n)) es" by (auto intro: id_take_nth_drop)
        with suc1 have "increasing (take (Suc n) es @ es!(Suc n) # drop (Suc (Suc n)) es)" by auto
        then have " i  (set (take (Suc n) es)). i   es ! (Suc n)" by (auto intro: increasing2)
        with suc1 have  " i  (set (take n es)). i   es ! (Suc n)" by (simp add: take_Suc_conv_app_nth)
        then have seq: "nths (take (Suc (es ! Suc n)) (verticesFrom f v)) (set (take n es))
          = nths (verticesFrom f v) (set (take n es))"
          apply (rule_tac nths_take) by auto
        from suc1 have "es = take n es @ es!n # drop (Suc n) es" by (auto intro: id_take_nth_drop)
        with suc1 have "increasing (take n es @ es!n # drop (Suc n) es)" by auto
        then have " i  (set (take n es)). i   es ! n" by (auto intro: increasing2)
        with suc1 esn have  " i  (set (take n es)). i   es ! n'" by (simp add: take_Suc_conv_app_nth)
        with Suc have seq2: "nths (take (Suc (es ! n')) (verticesFrom f v)) (set (take n es))
         = nths  (verticesFrom f v) (set (take n es))"
          apply (rule_tac nths_take) by auto
        from Suc suc1 have "(insert (es ! n') (set (take n es))) = set (take n es)"
        apply auto by (simp add: take_Suc_conv_app_nth)
        with esn None suc1 seq seq2 n' show ?thesis by (simp add: take_Suc_conv_app_nth)
      qed
    qed
  next
    case (Some v') then show ?thesis
    proof (cases n)
      case 0
      from suc1 lvs have "verticesFrom f v  []" by auto
      then have "verticesFrom f v = hd (verticesFrom f v) # tl (verticesFrom f v)" by auto
      then have "verticesFrom f v = v # tl (verticesFrom f v)" by (simp add: verticesFrom_hd)
      then obtain z where "verticesFrom f v = v # z" by auto
      then have sub: "nths (verticesFrom f v) {0} = [v]" by (auto simp: nths_Cons)
      from 0 suc1 have "es!0 = 0" by (cases es)  auto
      with 0 Some suc1 lvs sub vsne show ?thesis
        by (simp add: take_Suc_conv_app_nth natToVertexList_nth_0 nextVertices_def take_Suc
        nths_Cons verticesFrom_hd del:verticesFrom_empty)
    next
      case (Suc n')
      with Some suc1 lvs have esn: "es!n  es!n'" by (simp add: natToVertexList_nth_Suc split: if_split_asm)
      from suc1 Suc have "Suc n' < length es" by auto
      with suc1 lvs esn  have "natToVertexList v f es !(Suc n') = Some (f(es!(Suc n'))  v)"
      apply (simp add: natToVertexList_nth_Suc)
        by (simp add: Suc)
      with Suc have "natToVertexList v f es ! n = Some (f(es!n)  v)" by auto
      with Some have v': "v' = f(es!n)  v" by simp
      from Suc have n': "n - Suc 0 = n'" by auto
      from suc1 Suc have "es = take (Suc n') es @ es!n # drop (Suc n) es" by (auto intro: id_take_nth_drop)
      with suc1 have  "increasing (take (Suc n') es @ es!n # drop (Suc n) es)" by auto
      with suc1 Suc have "es!n'   es!n" apply (auto intro!: increasing2)
      by (auto simp: take_Suc_conv_app_nth)
      with esn have smaller_n: "es!n' < es!n" by auto
      from suc1 lvs have smaller: "(es!n) < length vs" by auto
      from suc1 smaller lvs have "(verticesFrom f v)!(es!n) =  f(es!n)  v" by (auto intro: verticesFrom_nth)
      with v' have "(verticesFrom f v)!(es!n) = v'" by auto
      then have sub1: "nths ([((verticesFrom f v)!(es!n))])
          {j. j + (es!n) : (insert (es ! n) (set (take n es)))} = [v']" by auto

      from suc1 smaller lvs have len: "length (take (es ! n) (verticesFrom f v)) = es!n" by auto

      have "x. x  (set (take n es))  x < (es ! n)"
      proof -
        fix x
        assume x: "x  set (take n es)"
        from suc1 Suc have "es = take n' es @ es!n' # drop (Suc n') es" by (auto intro: id_take_nth_drop)
        with suc1 have "increasing (take n' es @ es!n' # drop (Suc n') es)" by auto
        then have " x. x  set (take n' es)  x  es!n'" by (auto intro!: increasing2)
        with x Suc suc1 have "x  es!n'" by (auto simp: take_Suc_conv_app_nth)
        with smaller_n show "x < es!n" by auto
      qed
      then have "{i. i < es ! n  i  set (take n es)} = (set (take n es))" by auto
      then have elim_insert: "{i. i < es ! n  i  insert (es ! n) (set (take n es))} = (set (take n es))" by auto

      have "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
        nths (take (es ! n) (verticesFrom f v)) {i. i < length (take (es ! n) (verticesFrom f v))
          i  (insert (es ! n) (set (take n es)))}" by (rule nths_reduceIndices)
      with len have "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
        nths (take (es ! n) (verticesFrom f v)) {i. i < (es ! n)  i  (insert (es ! n) (set (take n es)))}"
        by simp
      with elim_insert have sub2: "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
        nths (take (es ! n) (verticesFrom f v)) (set (take n es))" by simp

      define m where "m = es!n - es!n'"
      with smaller_n have mgz: "0 < m" by auto
      with m_def have esn: "es!n = (es!n') + m" by auto

      have helper: "x. x  (set (take n es))  x   (es ! n')"
      proof -
        fix x
        assume x: "x  set (take n es)"
        from suc1 Suc have "es = take n' es @ es!n' # drop (Suc n') es" by (auto intro: id_take_nth_drop)
        with suc1 have "increasing (take n' es @ es!n' # drop (Suc n') es)" by auto
        then have " x. x  set (take n' es)  x  es!n'" by (auto intro!: increasing2)
        with x Suc suc1 show "x  es!n'" by (auto simp: take_Suc_conv_app_nth)
      qed

      define m' where "m' = m - 1"
      define Suc_es_n' where "Suc_es_n' = Suc (es!n')"

      from smaller smaller_n have "Suc (es!n') < length vs" by auto
      then have "min (length vs) (Suc (es ! n')) = Suc (es!n')" by arith
      with Suc_es_n'_def have empty: "{j. j + length (take Suc_es_n' vs)  set (take n es)} = {}"
        apply auto apply (frule helper) by arith


      from Suc_es_n'_def mgz esn m'_def have esn': "es!n = Suc_es_n' + m'" by auto

      with smaller have "(take (Suc_es_n' + m') vs) = take (Suc_es_n') vs @ take m' (drop (Suc_es_n') vs)"
        by (auto intro: take_add)
      with esn' have "nths (take (es ! n) vs) (set (take n es))
         = nths (take (Suc_es_n') vs @ take m' (drop (Suc_es_n') vs)) (set (take n es))" by auto
      then have "nths (take (es ! n) vs) (set (take n es)) =
        nths (take (Suc_es_n') vs) (set (take n es)) @
        nths (take m' (drop (Suc_es_n') vs)) {j. j + length (take (Suc_es_n') vs) : (set (take n es))}"
        by (simp add: nths_append)
      with empty Suc_es_n'_def have "nths (take (es ! n) vs) (set (take n es)) =
        nths (take (Suc (es!n')) vs) (set (take n es))" by simp
      with suc1 sub2 have sub3: "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
        nths (take (Suc (es!n')) (verticesFrom f v)) (set (take n es))" by simp
        
      from smaller suc1 have "take (Suc (es ! n)) (verticesFrom f v)
       = take (es ! n) (verticesFrom f v) @ [((verticesFrom f v)!(es!n))]"
       by (auto simp: take_Suc_conv_app_nth)
      with suc1 smaller have
        "nths (take (Suc (es ! n)) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
         nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es)))
         @ nths ([((verticesFrom f v)!(es!n))])  {j. j + (es!n) : (insert (es ! n) (set (take n es)))}"
        by (auto simp: nths_append)
      with sub1 sub3 have "nths (take (Suc (es ! n)) (verticesFrom f v)) (insert (es ! n) (set (take n es)))
       = nths (take (Suc (es ! n')) (verticesFrom f v)) (set (take n es)) @ [v']" by auto
      with Some suc1 lvs n' show ?thesis by (simp add: take_Suc_conv_app_nth)
    qed
  qed
qed

lemma natToVertexList_nths: "distinct (vertices f)  v  𝒱 f 
  incrIndexList es (length es) (length (vertices f)) 
  nths (verticesFrom f v) (set es) = removeNones (natToVertexList v f es)"
proof -
  assume vors1: "distinct (vertices f)" "v  𝒱 f"
     "incrIndexList es (length es) (length (vertices f))"
  define vs where "vs = verticesFrom f v"
  with vors1 have lvs: "length vs = length (vertices f)"  by (auto intro: verticesFrom_length)
  with vors1 vs_def have vors: "distinct (vertices f)" "v  𝒱 f"
    "vs = verticesFrom f v"  "incrIndexList es (length es) (length vs)" by auto

  with lvs have vsne: "vs  []" by auto
  define n where "n = length es"
  then have "es!(n - 1) = last es"
  proof (cases n)
    case 0 with n_def vors show ?thesis by (cases es)  auto
  next
    case (Suc n')
    with n_def have small_n': "n' < length es" by arith
    from Suc n_def have "take (Suc n') es = es" by auto
    with small_n' have "take n' es @ [es!n'] = es" by (simp add: take_Suc_conv_app_nth)
    then have "es!n' = last es" by (cases es rule: rev_exhaust) auto
    with Suc show ?thesis by auto
  qed
  with vors have "es!(n - 1) = (length vs) - 1" by auto
  with vsne have "Suc (es! (n - 1)) = (length vs)" by auto
  then have take_vs: "take (Suc (es!(n - 1))) vs = vs" by auto

  from n_def vors have "n =  length (natToVertexList v f es)" by auto
  then have take_nTVL: "take n (natToVertexList v f es) = natToVertexList v f es" by auto

  from n_def have take_es: "take n es = es" by auto

  from n_def have "n  length es" by auto
  with vors   have "nths (take (Suc (es!(n - 1))) vs) (set (take n es))
    = removeNones (take n (natToVertexList v f es))" by (rule natToVertexList_nths1)
  with take_vs take_nTVL take_es vs_def show ?thesis by simp
qed


lemma filter_Cons2:
 "x  set ys  [yys.  y = x  P y] = [yys. P y]"
 by (induct ys) (auto)

lemma natToVertexList_removeNones:
  "distinct (vertices f)  v  𝒱 f 
  incrIndexList es (length es) (length (vertices f)) 
  [xverticesFrom f v. x  set (removeNones (natToVertexList v f es))]
 = removeNones (natToVertexList v f es)"
proof -
  assume vors: "distinct (vertices f)" "v  𝒱 f"
    "incrIndexList es (length es) (length (vertices f))"
  then have dist: "distinct (verticesFrom f v)" by auto
  from vors have sub_eq: "nths (verticesFrom f v) (set es)
    = removeNones (natToVertexList v f es)" by (rule natToVertexList_nths)
  from dist have "[x  verticesFrom f v.
    x  set (nths (verticesFrom f v) (set es))] = removeNones (natToVertexList v f es)"
  apply (simp add: filter_in_nths)
    by (simp add: sub_eq)
  with sub_eq show ?thesis by simp
qed

(**************************** invalidVertexList ************)

definition is_duplicateEdge :: "graph  face  vertex  vertex  bool" where
 "is_duplicateEdge g f a b 
   ((a, b)  edges g  (a, b)  edges f  (b, a)  edges f)
  ((b, a)  edges g  (b, a)  edges f  (a, b)  edges f)"

definition invalidVertexList :: "graph  face  vertex option list  bool" where
 "invalidVertexList g f vs 
     i < |vs|- 1.
         case vs!i of None  False
             | Some a  case vs!(i+1) of None  False
             | Some b  is_duplicateEdge g f a b"


(**************************** subdivFace **********************)

subsection pre_subdivFace(')›

definition pre_subdivFace_face :: "face  vertex  vertex option list  bool" where
"pre_subdivFace_face f v' vOptionList 
     [v  verticesFrom f v'. v  set (removeNones vOptionList)]
       = (removeNones vOptionList)
   ¬ final f  distinct (vertices f)
   hd (vOptionList) = Some v'
   v'  𝒱 f
   last (vOptionList) =  Some (last (verticesFrom f v'))
   hd (tl (vOptionList))  last (vOptionList)
   2 < | vOptionList |
   vOptionList   []
   tl (vOptionList)  []"

definition pre_subdivFace :: "graph  face  vertex  vertex option list  bool" where
"pre_subdivFace g f v' vOptionList 
  pre_subdivFace_face f v' vOptionList  ¬ invalidVertexList g f vOptionList"

(* zu teilende Fläche, ursprüngliches v, erster Ram-Punkt, Anzahl der überlaufenen NOnes, rest der vol *)
definition pre_subdivFace' :: "graph  face  vertex  vertex  nat  vertex option list  bool" where
"pre_subdivFace' g f v' ram1 n vOptionList 
  ¬ final f  v'  𝒱 f  ram1  𝒱 f
   v'  set (removeNones vOptionList)
   distinct (vertices f)
   (
    [v  verticesFrom f v'. v  set (removeNones vOptionList)]
        =  (removeNones vOptionList)
   before (verticesFrom f v') ram1 (hd (removeNones vOptionList))
   last (vOptionList) =  Some (last (verticesFrom f v'))
   vOptionList   []
   ((v' = ram1  (0 < n))  ((v' = ram1  (hd (vOptionList)  Some (last (verticesFrom f v'))))   (v'  ram1)))
   ¬ invalidVertexList g f vOptionList
   (n = 0  hd (vOptionList)  None   ¬ is_duplicateEdge g f ram1 (the (hd (vOptionList))))
   (vOptionList = []  v'  ram1)
  )"


lemma pre_subdivFace_face_in_f[intro]: "pre_subdivFace_face f v ls  Some a  set ls  a  set (verticesFrom f v)"
  apply (subgoal_tac "a  set (removeNones ls)") apply (auto  simp: pre_subdivFace_face_def)
  apply (subgoal_tac "a  set [vverticesFrom f v . v  set (removeNones ls)]")
  apply (thin_tac "[vverticesFrom f v . v  set (removeNones ls)] = removeNones ls") by auto

lemma pre_subdivFace_in_f[intro]: "pre_subdivFace g f v ls  Some a  set ls  a  set (verticesFrom f v)"
 by (auto simp: pre_subdivFace_def)


lemma pre_subdivFace_face_in_f'[intro]: "pre_subdivFace_face f v ls  Some a  set ls  a  𝒱 f"
  apply (cases "a = v") apply (force simp: pre_subdivFace_face_def)
 apply (rule verticesFrom_in') apply (rule pre_subdivFace_face_in_f)
by auto


lemma filter_congs_shorten1: "distinct (verticesFrom f v)  [vverticesFrom f v . v = a  v  set vs] = (a # vs)
     [vverticesFrom f v . v  set vs] = vs"
proof -
  assume dist: "distinct (verticesFrom f v)" and eq: "[vverticesFrom  f v . v = a  v  set vs] = (a # vs)"
  have rule1: " vs a ys. distinct vs  [vvs . v = a  v  set ys] = a # ys  [vvs. v  set ys] = ys"
  proof -
    fix vs a ys
    assume dist: "distinct vs" and ays:  "[vvs . v = a  v  set ys] = a # ys"
    then have "distinct ([vvs . v = a  v  set ys])" by (rule_tac distinct_filter)
    with ays have distys: "distinct (a # ys)" by simp
    from dist distys ays show "[vvs. v  set ys] = ys"
     apply (induct vs) by (auto  split: if_split_asm simp: filter_Cons2)
  qed

  from dist eq show ?thesis  by (rule_tac rule1)
qed

lemma ovl_shorten: "distinct (verticesFrom f v) 
  [vverticesFrom f v . v  set (removeNones (va # vol))] = (removeNones (va # vol))
     [vverticesFrom f v . v  set (removeNones (vol))] =  (removeNones (vol))"
proof -
  assume dist: "distinct (verticesFrom f v)"
  and vors: "[vverticesFrom f v . v  set (removeNones (va # vol))] = (removeNones (va # vol))"
  then show ?thesis
  proof (cases va)
    case None with vors Cons show ?thesis by auto
  next
    case (Some a) with vors dist show ?thesis by (auto intro!: filter_congs_shorten1)
  qed
qed

lemma pre_subdivFace_face_distinct: "pre_subdivFace_face f v vol  distinct (removeNones vol)"
  apply (auto dest!: verticesFrom_distinct simp: pre_subdivFace_face_def)
  apply (subgoal_tac "distinct ([vverticesFrom f v . v  set (removeNones vol)])") apply simp
  apply (thin_tac "[vverticesFrom f v . v  set (removeNones vol)] = removeNones vol") by auto

lemma invalidVertexList_shorten: "invalidVertexList g f vol  invalidVertexList g f (v # vol)"
apply (simp add: invalidVertexList_def) apply auto apply (rule exI) apply safe
apply (subgoal_tac "(Suc i) < | vol |") apply assumption apply arith
apply auto apply (case_tac "vol!i") by auto

lemma pre_subdivFace_pre_subdivFace': "v  𝒱 f  pre_subdivFace g f v (vo # vol) 
  pre_subdivFace' g f v v 0 (vol)"
proof -
  assume vors:  "v  𝒱 f"  "pre_subdivFace g f v (vo # vol)"
  then have vors': "v  𝒱 f" "pre_subdivFace_face f v (vo # vol)" "¬ invalidVertexList g f (vo # vol)"
    by (auto simp: pre_subdivFace_def)
  then have r: "removeNones vol  []" apply (cases "vol" rule: rev_exhaust) by  (auto  simp: pre_subdivFace_face_def)
  then have "Some (hd (removeNones vol))  set vol" apply (induct vol) apply auto apply (case_tac a) by auto
  then have "Some (hd (removeNones vol))  set (vo # vol)" by auto
  with vors' have hd: "hd (removeNones vol)  𝒱 f" by (rule_tac pre_subdivFace_face_in_f')

  from vors' have "Some v = vo" by (auto  simp: pre_subdivFace_face_def)
  with vors'  have "v  set (tl (removeNones (vo # vol)))" apply (drule_tac pre_subdivFace_face_distinct) by auto
  with vors' r have ne: "v  hd (removeNones vol)" by (cases  "removeNones vol")  (auto  simp: pre_subdivFace_face_def)

  from vors' have dist: "distinct (removeNones (vo # vol))"  apply (rule_tac pre_subdivFace_face_distinct) .

  from vors' have invalid: "¬ invalidVertexList g f vol" by (auto simp: invalidVertexList_shorten)


  from ne hd vors' invalid dist show ?thesis apply (unfold pre_subdivFace'_def)
    apply (simp add: pre_subdivFace'_def pre_subdivFace_face_def)
    apply safe
        apply (rule ovl_shorten)
         apply (simp add: pre_subdivFace_face_def) apply assumption
       apply (rule before_verticesFrom)
          apply simp+
    apply (simp add: invalidVertexList_def)
    apply (erule allE)
    apply (erule impE)
    apply (subgoal_tac "0 <  |vol|")
      apply (thin_tac "Suc 0 < | vol |")
      apply  assumption
     apply simp
    apply (simp)
    apply (case_tac "vol") apply simp by (simp add: is_duplicateEdge_def)
qed


lemma pre_subdivFace'_distinct: "pre_subdivFace' g f v' v n vol  distinct (removeNones vol)"
  apply (unfold pre_subdivFace'_def)
  apply (cases vol) apply simp+
  apply (elim conjE)
  apply (drule_tac verticesFrom_distinct) apply assumption
  apply (subgoal_tac "distinct [vverticesFrom f v' . v  set (removeNones (a # list))]") apply force
  apply (thin_tac "[vverticesFrom f v' . v  set (removeNones (a # list))] = removeNones (a # list)")
  by auto


lemma natToVertexList_pre_subdivFace_face:
 "¬ final f  distinct (vertices f)  v  𝒱 f  2 < |es| 
 incrIndexList es (length es) (length (vertices f)) 
 pre_subdivFace_face f v (natToVertexList v f es)"
proof -
  assume vors: "¬ final f" "distinct (vertices f)" "v  𝒱 f" "2 < |es|"
     "incrIndexList es (length es) (length (vertices f))"
  then have lastOvl: "last (natToVertexList v f es) =  Some (last (verticesFrom f v))" by auto

  from vors have nvl_l: "2 < | natToVertexList v f es |"
    by auto

  from vors have "distinct [xverticesFrom f v . x  set (removeNones (natToVertexList v f es))]" by auto
  with vors have "distinct (removeNones (natToVertexList v f es))" by (simp add: natToVertexList_removeNones)
  with nvl_l lastOvl have hd_last: "hd (tl (natToVertexList v f es))  last (natToVertexList v f es)" apply auto
    apply (cases "natToVertexList v f es") apply simp
    apply (case_tac "list" rule: rev_exhaust) apply simp
    apply (case_tac "ys") apply simp
    apply (case_tac "a") apply simp by simp

  from vors lastOvl hd_last nvl_l show ?thesis
    apply (auto intro: natToVertexList_removeNones simp: pre_subdivFace_face_def)
    apply (cases es) apply auto
    apply (cases es) apply auto
    apply (subgoal_tac "0 < length list") apply (case_tac list) by (auto split: if_split_asm)
qed


lemma indexToVertexList_pre_subdivFace_face:
 "¬ final f  distinct (vertices f)  v  𝒱 f  2 < |es| 
 incrIndexList es (length es) (length (vertices f)) 
 pre_subdivFace_face f v (indexToVertexList f v es)"
apply (subgoal_tac "indexToVertexList f v es = natToVertexList v f es") apply simp
apply (rule natToVertexList_pre_subdivFace_face) apply assumption+
apply (rule indexToVertexList_natToVertexList_eq) by auto

lemma subdivFace_subdivFace'_eq: "pre_subdivFace g f v vol   subdivFace g f vol = subdivFace' g f v 0 (tl vol)"
by (simp_all add: subdivFace_def pre_subdivFace_def pre_subdivFace_face_def)

lemma pre_subdivFace'_None:
 "pre_subdivFace' g f v' v n (None # vol) 
  pre_subdivFace' g f v' v (Suc n) vol"
by(auto simp: pre_subdivFace'_def dest:invalidVertexList_shorten
        split:if_split_asm)

declare verticesFrom_between [simp del]


(* zu zeigen:
 1. vol ≠ [] ⟹ [v∈verticesFrom f21 v' . v ∈ set (removeNones vol)] = removeNones vol
 2. vol ≠ [] ⟹ before (verticesFrom f21 v') u (hd (removeNones vol))
 3. vol ≠ [] ⟹ distinct (vertices f21)
 4. vol ≠ [] ⟹ last vol = Some (last (verticesFrom f21 v'))
*)

lemma verticesFrom_split: "v # tl (verticesFrom f v) = verticesFrom f v" by (auto simp: verticesFrom_Def)

lemma verticesFrom_v: "distinct (vertices f)  vertices f = a @ v # b  verticesFrom f v = v # b @ a"
by (simp add: verticesFrom_Def)


lemma splitAt_fst[simp]: "distinct xs  xs = a @ v # b  fst (splitAt v xs) = a"
by auto

lemma splitAt_snd[simp]: "distinct xs  xs = a @ v # b  snd (splitAt v xs) = b"
by auto

lemma verticesFrom_splitAt_v_fst[simp]:
  "distinct (verticesFrom f v)  fst (splitAt v (verticesFrom f v)) = []"
  by (simp add: verticesFrom_Def)
lemma verticesFrom_splitAt_v_snd[simp]:
  "distinct (verticesFrom f v)  snd (splitAt v (verticesFrom f v)) = tl (verticesFrom f v)"
  by (simp add: verticesFrom_Def)


lemma filter_distinct_at:
  "distinct xs  xs = (as @ u # bs)  [vxs. v = u  P v] = u # us 
  [vbs. P v] = us  [vas. P v] = []"
apply (subgoal_tac "filter P as @ u # filter P bs = [] @ u # us")
apply (drule local_help')  by (auto simp: filter_Cons2)

lemma filter_distinct_at3: "distinct xs  xs = (as @ u # bs) 
  [vxs. v = u  P v] = u # us   z  set zs. z  set as  ¬ ( P z) 
  [vzs@bs. P v] = us"
apply (drule filter_distinct_at) apply assumption+ apply simp
by (induct zs) auto

lemma filter_distinct_at4: "distinct xs  xs = (as @ u # bs)
   [vxs. v = u  v  set us] = u # us
   set zs  set us  {u}  set as
   [v  zs@bs. v  set us] = us"
proof -
  assume vors: "distinct xs" "xs = (as @ u # bs)"
    "[vxs. v = u  v  set us] = u # us"
    "set zs  set us  {u}  set as"
  then have "distinct ([vxs. v = u  v  set us])"  apply (rule_tac distinct_filter) by simp
  with vors have dist: "distinct (u # us)" by auto
  with vors show ?thesis
  apply (rule_tac filter_distinct_at3) by assumption+  auto
qed

lemma filter_distinct_at5: "distinct xs  xs = (as @ u # bs)
   [vxs. v = u  v  set us] = u # us
   set zs  set xs  {u}  set as
   [v  zs@bs. v  set us] = us"
proof -
  assume vors: "distinct xs" "xs = (as @ u # bs)"
    "[vxs. v = u  v  set us] = u # us"
    "set zs  set xs  {u}  set as"
  have "set ([vxs. v = u  v  set us])  set xs" by auto
  with vors have "set (u # us)  set xs" by simp
  then have "set us  set xs" by simp
  with vors have "set zs  set us  set zs  insert u (set as  set bs)" by auto
  with vors show ?thesis apply (rule_tac filter_distinct_at4) apply assumption+ by auto
qed

lemma filter_distinct_at6: "distinct xs  xs = (as @ u # bs)
   [vxs. v = u  v  set us] = u # us
   set zs  set xs  {u}  set as
   [v  zs@bs. v  set us] = us  [v  bs. v  set us] = us"
proof -
  assume vors: "distinct xs" "xs = (as @ u # bs)"
    "[v  xs. v = u  v  set us] = u # us"
    "set zs  set xs  {u}  set as"
  then show ?thesis apply (rule_tac conjI)  apply (rule_tac filter_distinct_at5) apply assumption+
  apply (drule filter_distinct_at) apply assumption+ by auto
qed

lemma filter_distinct_at_special:
  "distinct xs  xs = (as @ u # bs)
   [vxs. v = u  v  set us] = u # us
   set zs  set xs  {u}  set as
   us = hd_us # tl_us
   [v  zs@bs. v  set us] = us  hd_us  set bs"
proof -
  assume vors: "distinct xs" "xs = (as @ u # bs)"
    "[vxs. v = u  v  set us] = u # us"
    "set zs  set xs  {u}  set as"
    "us = hd_us # tl_us"
  then have "[v  zs@bs. v  set us] = us  [vbs. v  set us] = us"
    by (rule_tac filter_distinct_at6)
  with vors show ?thesis apply (rule_tac conjI) apply safe apply simp
    apply (subgoal_tac "set (hd_us # tl_us)  set bs") apply simp
    apply (subgoal_tac "set [vbs . v = hd_us  v  set tl_us]  set bs")  apply simp
    by (rule_tac filter_is_subset)
qed




(* später ggf. pre_splitFace eliminieren *)
(* nein, Elimination nicht sinnvoll *)
lemma pre_subdivFace'_Some1':
assumes pre_add: "pre_subdivFace' g f v' v n ((Some u) # vol)"
    and pre_fdg: "pre_splitFace g v u f ws"
    and fdg:  "f21 = fst (snd (splitFace g v u f ws))"
    and g': "g' =  snd (snd (splitFace g v u f ws))"
shows "pre_subdivFace' g' f21 v' u 0 vol"
proof (cases "vol = []")
  case True then show ?thesis using pre_add fdg pre_fdg
    apply(unfold pre_subdivFace'_def pre_splitFace_def)
    apply (simp add: splitFace_def split_face_def split_def del:distinct.simps)
    apply (rule conjI)
     apply(clarsimp)
     apply(rule before_between)
        apply(erule (5) rotate_before_vFrom)
     apply(erule not_sym)
    apply (clarsimp simp:between_distinct between_not_r1 between_not_r2)
    apply(blast dest:inbetween_inset)
    done
next
  case False
  with pre_add
  have "removeNones vol  []" apply (cases "vol" rule: rev_exhaust) by (auto simp: pre_subdivFace'_def)
  then have removeNones_split: "removeNones vol = hd (removeNones vol) # tl (removeNones vol)" by auto


  from pre_add have dist: "distinct (removeNones ((Some u) # vol))" by (rule_tac pre_subdivFace'_distinct)

  from pre_add have v': "v'  𝒱 f" by (auto simp: pre_subdivFace'_def)
  hence "(vertices f)  (verticesFrom f v')" by (rule verticesFrom_congs)
  hence set_eq: "set (verticesFrom f v') = 𝒱 f"
     apply (rule_tac sym) by (rule congs_pres_nodes)

  from pre_fdg fdg have dist_f21: "distinct (vertices f21)" by auto

  from pre_add have pre_bet': "pre_between (verticesFrom f v') u v"
    apply (simp add: pre_between_def pre_subdivFace'_def)
    apply (elim conjE) apply (thin_tac "n = 0  ¬ is_duplicateEdge g f v u")
    apply (thin_tac "v' = v  0 < n  v' = v  u  last (verticesFrom f v')  v'  v")
    apply (auto simp add: before_def)
    apply (subgoal_tac "distinct (verticesFrom f v')")  apply simp
    apply (rule_tac verticesFrom_distinct) by auto

  with pre_add have pre_bet: "pre_between (vertices f) u v"
    apply (subgoal_tac "(vertices f)  (verticesFrom f v')")
     apply (simp add: pre_between_def pre_subdivFace'_def)
    by (auto dest: congs_pres_nodes intro: verticesFrom_congs simp: pre_subdivFace'_def)

   from pre_bet pre_add have bet_eq[simp]: "between (vertices f) u v = between (verticesFrom f v') u v"
    by (auto intro: verticesFrom_between simp: pre_subdivFace'_def)

  from fdg have f21_split_face: "f21 = snd (split_face f v u ws)"
    by (simp add: splitFace_def split_def)
  then have f21: "f21 = Face (u # between (vertices f) u v @ v # ws) Nonfinal"
    by (simp add: split_face_def)
  with pre_add pre_bet'
  have vert_f21: "vertices f21
   = u # snd (splitAt u (verticesFrom f v')) @ fst (splitAt v (verticesFrom f v')) @ v # ws"
    apply (drule_tac pre_between_symI)
    by (auto simp: pre_subdivFace'_def between_simp2 intro: pre_between_symI)

  moreover
  from pre_add have "v  set (verticesFrom f v')" by (auto simp: pre_subdivFace'_def before_def)
  then have "verticesFrom f v' =
   fst (splitAt v (verticesFrom f v')) @ v # snd (splitAt v (verticesFrom f v'))"
   by (auto dest: splitAt_ram)
  then have m: "v' # tl (verticesFrom f v')
    =  fst (splitAt v (verticesFrom f v')) @ v # snd (splitAt v (verticesFrom f v'))"
    by (simp add: verticesFrom_split)

  then have vv': "v  v'  fst (splitAt v (verticesFrom f v'))
    = v' # tl (fst (splitAt v (verticesFrom f v')))"
   by (cases "fst (splitAt v (verticesFrom f v'))") auto

  ultimately have "v  v'  vertices f21
    = u # snd (splitAt u (verticesFrom f v')) @ v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws"
    by auto

  moreover
  with f21 have rule2: "v'  𝒱 f21" by auto
  with dist_f21 have dist_f21_v': "distinct (verticesFrom f21 v')" by auto

  ultimately have m1: "v  v'  verticesFrom f21 v'
     = v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ u # snd (splitAt u (verticesFrom f v'))"
    apply auto
    apply (subgoal_tac "snd (splitAt v' (vertices f21)) = tl (fst (splitAt v (verticesFrom f v'))) @ v # ws")
     apply (subgoal_tac "fst (splitAt v' (vertices f21)) = u # snd (splitAt u (verticesFrom f v'))")
      apply (subgoal_tac "verticesFrom f21 v' = v' # snd (splitAt v' (vertices f21)) @ fst (splitAt v' (vertices f21))")
       apply simp
      apply (intro verticesFrom_v dist_f21) apply force
     apply (subgoal_tac "distinct (vertices f21)") apply simp
     apply (rule_tac dist_f21)
    apply (subgoal_tac "distinct (vertices f21)") apply simp
    by (rule_tac dist_f21)

  from pre_add have dist_vf_v': "distinct (verticesFrom f v')" by (simp add: pre_subdivFace'_def)
  with  vert_f21 have m2: "v = v'  verticesFrom f21 v' = v' # ws @ u # snd (splitAt u (verticesFrom f v'))"
    apply auto apply (intro verticesFrom_v dist_f21) by simp

  from pre_add have u: "u  set (verticesFrom f v')" by (fastforce simp: pre_subdivFace'_def before_def)
  then have split_u: "verticesFrom f v'
    = fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
    by (auto dest!: splitAt_ram)

  then have rule1': "[v  snd (splitAt u (verticesFrom f v')) . v  set (removeNones vol)] = removeNones vol"
  proof -
    from split_u have "v' # tl (verticesFrom f v')
       =  fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
      by (simp add: verticesFrom_split)
    have "help": "set []  set (verticesFrom f v')  {u}  set (fst (splitAt u (verticesFrom f v')))" by auto
    from split_u  dist_vf_v'  pre_add
    have "[v  [] @ snd (splitAt u (verticesFrom f v')) . v  set (removeNones vol)] = removeNones vol"
      apply (rule_tac filter_distinct_at5) apply assumption+
      apply (simp add: pre_subdivFace'_def) by (rule "help")
    then show ?thesis by auto
  qed
  then have inSnd_u: " x. x  set (removeNones vol)  x  set (snd (splitAt u (verticesFrom f v')))"
    apply (subgoal_tac "x  set [v  snd (splitAt u (verticesFrom f v')) . v  set (removeNones vol)] 
      x  set (snd (splitAt u (verticesFrom f v')))")
    apply force apply (thin_tac "[v  snd (splitAt u (verticesFrom f v')) . v  set (removeNones vol)] = removeNones vol")
    by simp

  from split_u dist_vf_v' have notinFst_u: " x. x  set (removeNones vol) 
      x  set ((fst (splitAt u (verticesFrom f v'))) @ [u])" apply (drule_tac inSnd_u)
    apply (subgoal_tac "distinct ( fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v')))")
    apply (thin_tac "verticesFrom f v'
       = fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))")
    apply simp apply safe
    apply (subgoal_tac "x  set (fst (splitAt u (verticesFrom f v')))  set (snd (splitAt u (verticesFrom f v')))")
    apply simp
    apply (thin_tac "set (fst (splitAt u (verticesFrom f v')))  set (snd (splitAt u (verticesFrom f v'))) = {}")
    apply simp
    by (simp only:)

  from rule2 v' have " a b. is_nextElem (vertices f) a b  a  set (removeNones vol)  b  set (removeNones vol)  
   is_nextElem (vertices f21) a b"
  proof -
    fix a b
    assume vors: "is_nextElem (vertices f) a b  a  set (removeNones vol)  b  set (removeNones vol)"
    define vor_u where "vor_u = fst (splitAt u (verticesFrom f v'))"
    define nach_u where "nach_u = snd (splitAt u (verticesFrom f v'))"
    from vors v' have "is_nextElem (verticesFrom f v') a b"  by (simp add: verticesFrom_is_nextElem)
    moreover
    from vors inSnd_u nach_u_def have "a  set (nach_u)" by auto
    moreover
    from vors inSnd_u nach_u_def have "b  set (nach_u)" by auto
    moreover
    from split_u vor_u_def nach_u_def have "verticesFrom f v' = vor_u @ u # nach_u" by auto
    moreover
    note dist_vf_v'
    ultimately have "is_sublist [a,b] (nach_u)" apply (simp add: is_nextElem_def split:if_split_asm)
      apply (subgoal_tac "b  hd (vor_u @ u # nach_u)")
       apply simp
       apply (subgoal_tac "distinct (vor_u @ (u # nach_u))")
        apply (drule is_sublist_at5)
         apply simp
        apply simp
        apply (erule disjE)
         apply (drule is_sublist_in1)+
         apply (subgoal_tac "b  set vor_u  set nach_u") apply simp
         apply (thin_tac "set vor_u  set nach_u = {}")
         apply simp
        apply (erule disjE)
         apply (subgoal_tac "distinct ([u] @ nach_u)")
          apply (drule is_sublist_at5)
           apply simp
          apply simp
          apply (erule disjE)
           apply simp
          apply simp
         apply simp
        apply (subgoal_tac "distinct (vor_u @ (u # nach_u))")
         apply (drule is_sublist_at5) apply simp
        apply (erule disjE)
         apply (drule is_sublist_in1)+
         apply simp
        apply (erule disjE)
         apply  (drule is_sublist_in1)+ apply simp
        apply simp
       apply simp
      apply simp
     apply (cases "vor_u") by auto

    with nach_u_def have "is_sublist [a,b] (snd (splitAt u (verticesFrom f v')))" by auto
    then have "is_sublist [a,b] (verticesFrom f21 v')"
      apply (cases "v = v'") apply (simp_all add: m1 m2)
      apply (subgoal_tac "is_sublist [a, b] ((v' # ws @ [u]) @ snd (splitAt u (verticesFrom f v')) @ [])")
      apply simp apply (rule is_sublist_add) apply simp
      apply (subgoal_tac "is_sublist [a, b]
       ((v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u]) @ (snd (splitAt u (verticesFrom f v'))) @ [])")
      apply simp apply (rule is_sublist_add) by simp
    with rule2 show "is_nextElem (vertices f) a b  a  set (removeNones vol)  b  set (removeNones vol)  
      is_nextElem (vertices f21) a b" apply (simp add: verticesFrom_is_nextElem) by (auto simp: is_nextElem_def)
  qed
  with pre_add dist_f21 have rule5':
     " a b. (a,b)  edges f  a  set (removeNones vol)  b  set (removeNones vol)  (a, b)  edges f21"
    by (simp add:  is_nextElem_edges_eq pre_subdivFace'_def)


  have rule1: "[vverticesFrom f21 v' . v  set (removeNones vol)]
    = removeNones vol  hd (removeNones vol)  set (snd (splitAt u (verticesFrom f v')))"
  proof (cases "v = v'")
    case True
    from split_u have "v' # tl (verticesFrom f v')
      =  fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
      by (simp add: verticesFrom_split)
    then have "u  v'  fst (splitAt u (verticesFrom f v'))
      = v' # tl (fst (splitAt u (verticesFrom f v')))" by (cases "fst (splitAt u (verticesFrom f v'))") auto
    moreover
    have "v'  set (v' # tl (fst (splitAt u (verticesFrom f v'))))" by simp
    ultimately have "u  v'  v'  set (fst (splitAt u (verticesFrom f v')))" by simp
    moreover
    from pre_fdg have "set (v' # ws @ [u])  set (verticesFrom f v')   {v', u}"
      apply (simp add: set_eq)
      by (unfold pre_splitFace_def) auto
    ultimately have "help": "set (v' # ws @ [u])  set (verticesFrom f v')
       {u}  set (fst (splitAt u (verticesFrom f v')))" apply (rule_tac subset_trans)
      apply assumption apply (cases "u = v'") by simp_all
    from split_u dist_vf_v' pre_add pre_fdg removeNones_split have
      "[v  (v' # ws @ [u]) @ snd (splitAt u (verticesFrom f v')) . v  set (removeNones vol)]
      = removeNones vol  hd (removeNones vol)  set (snd (splitAt u (verticesFrom f v')))"
      apply (rule_tac filter_distinct_at_special) apply assumption+
      apply (simp add: pre_subdivFace'_def) apply (rule "help") .
    with True m2 show ?thesis by auto
  next
    case False

    with m1 dist_f21_v' have ne_uv': "u  v'" by auto
    define fst_u where "fst_u = fst (splitAt u (verticesFrom f v'))"
    define fst_v where "fst_v = fst (splitAt v (verticesFrom f v'))"

    from pre_add u dist_vf_v' have "v  set (fst (splitAt u (verticesFrom f v')))"
      apply (rule_tac before_dist_r1) by (auto  simp: pre_subdivFace'_def)
    with fst_u_def have "fst_u = fst (splitAt v (fst (splitAt u (verticesFrom f v'))))
         @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v'))))"
      by (auto dest: splitAt_ram)
    with pre_add fst_v_def pre_bet' have fst_u':"fst_u
      = fst_v @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v'))))" by (simp add: pre_subdivFace'_def)

    from pre_fdg have "set (v # ws @ [u])  set (verticesFrom f v')   {v, u}" apply (simp add: set_eq)
      by (unfold pre_splitFace_def) auto

    with fst_u' have "set (v # ws @ [u])  set (verticesFrom f v')  {u}  set fst_u" by auto
    moreover
    from fst_u' have "set fst_v  set fst_u" by auto
    ultimately
    have "(set (v # ws @ [u])  set fst_v)  set (verticesFrom f v')  {u}  set fst_u" by auto
    with fst_u_def fst_v_def
    have "set (fst (splitAt v (verticesFrom f v')) @ v # ws @ [u])  set (verticesFrom f v')
       {u}  set (fst (splitAt u (verticesFrom f v')))" by auto
    moreover
    with False vv' have  "v' # tl (fst (splitAt v (verticesFrom f v')))
      = fst (splitAt v (verticesFrom f v'))" by auto
    ultimately have "set ((v' # tl (fst (splitAt v (verticesFrom f v')))) @ v # ws @ [u])  set (verticesFrom f v')
       {u}  set (fst (splitAt u (verticesFrom f v')))"
     by (simp only:)
    then have "help": "set (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u])  set (verticesFrom f v')
       {u}  set (fst (splitAt u (verticesFrom f v')))" by auto


    from split_u dist_vf_v' pre_add pre_fdg removeNones_split have
      "[v  (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u])
          @ snd (splitAt u (verticesFrom f v')) . v  set (removeNones vol)]
       = removeNones vol  hd (removeNones vol)  set (snd (splitAt u (verticesFrom f v')))"
      apply (rule_tac filter_distinct_at_special) apply assumption+
      apply (simp add: pre_subdivFace'_def) apply (rule "help") .
    with False m1 show ?thesis by auto
  qed


  from rule1 have "(hd (removeNones vol))  set (snd (splitAt u (verticesFrom f v')))" by auto
  with m1 m2  dist_f21_v' have rule3: "before (verticesFrom f21 v') u (hd (removeNones vol))"
  proof -
    assume hd_ram: "(hd (removeNones vol))  set (snd (splitAt u (verticesFrom f v')))"
    from m1 m2 dist_f21_v' have "distinct (snd (splitAt u (verticesFrom f v')))" apply (cases "v = v'")
      by auto
    moreover
    define z1 where "z1 = fst (splitAt (hd (removeNones vol)) (snd (splitAt u (verticesFrom f v'))))"
    define z2 where "z2 = snd (splitAt (hd (removeNones vol)) (snd (splitAt u (verticesFrom f v'))))"
    note z1_def z2_def hd_ram
    ultimately have "snd (splitAt u (verticesFrom f v')) = z1 @ (hd (removeNones vol)) # z2"
      by (auto intro: splitAt_ram)
    with m1 m2 show ?thesis apply (cases "v = v'") apply (auto simp: before_def)
      apply (intro exI )
      apply (subgoal_tac "v' # ws @ u # z1 @ hd (removeNones vol) # z2 = (v' # ws) @ u # z1 @ hd (removeNones vol) # z2")
      apply assumption apply simp
      apply (intro exI )
      apply (subgoal_tac "v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ u # z1 @ hd (removeNones vol) # z2 =
        (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws) @ u # z1 @ hd (removeNones vol) # z2")
      apply assumption by simp
  qed

  from rule1 have ne:"(hd (removeNones vol))  set (snd (splitAt u (verticesFrom f v')))" by auto
  with m1 m2  have "last (verticesFrom f21 v') = last (snd (splitAt u (verticesFrom f v')))"
    apply (cases "snd (splitAt u (verticesFrom f v'))" rule: rev_exhaust) apply simp_all
    apply (cases "v = v'") by simp_all
  moreover
  from ne have "last (fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v')))
    = last (snd (splitAt u (verticesFrom f v')))" by auto
  moreover
  note split_u
  ultimately  have rule4: "last (verticesFrom f v') = last (verticesFrom f21 v')" by simp


  have l: " a b f v. v  set (vertices f)  is_nextElem (vertices f) a b = is_nextElem (verticesFrom f v) a b "
    apply (rule is_nextElem_congs_eq) by (rule verticesFrom_congs)

  define f12 where "f12 = fst (split_face f v u ws)"
  then have f12_fdg: "f12 = fst (splitFace g v u f ws)"
    by (simp add: splitFace_def split_def)

   from pre_bet pre_add have bet_eq2[simp]: "between (vertices f) v u = between (verticesFrom f v') v u"
     apply (drule_tac pre_between_symI)
     by (auto intro: verticesFrom_between simp: pre_subdivFace'_def)


  from f12_fdg have f12_split_face: "f12 = fst (split_face f v u ws)"
    by (simp add: splitFace_def split_def)
  then have f12: "f12 = Face (rev ws @ v # between (verticesFrom f v') v u @ [u]) Nonfinal"
    by (simp add: split_face_def)
  then have "vertices f12 = rev ws @ v # between (verticesFrom f v') v u @ [u]" by simp
  with pre_add pre_bet' have vert_f12: "vertices f12
     = rev ws @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v')))) @ [u]"
    apply (subgoal_tac "between (verticesFrom f v') v u = fst (splitAt u (snd (splitAt v (verticesFrom f v'))))")
     apply (simp  add: pre_subdivFace'_def)
    apply (rule between_simp1)
     apply (simp add: pre_subdivFace'_def)
    apply (rule pre_between_symI) .
  with dist_f21_v' have removeNones_vol_not_f12: " x. x  set (removeNones vol)  x  set (vertices f12)"
    apply (frule_tac notinFst_u) apply (drule inSnd_u) apply simp
    apply (case_tac "v = v'") apply (simp add: m1 m2)
    apply (rule conjI) apply force
    apply (rule conjI) apply (rule ccontr)  apply simp
    apply (subgoal_tac "x  set ws  set (snd (splitAt u (verticesFrom f v')))")
    apply simp apply (elim conjE)
    apply (thin_tac "set ws  set (snd (splitAt u (verticesFrom f v'))) = {}")
    apply simp
    apply force

    apply (simp add: m1 m2)
    apply (rule conjI) apply force
    apply (rule conjI) apply (rule ccontr) apply simp
    apply (subgoal_tac "x  set ws  set (snd (splitAt u (verticesFrom f v')))")
    apply simp apply (elim conjE)
    apply (thin_tac "set ws  set (snd (splitAt u (verticesFrom f v'))) = {}") apply simp
    by force

  from pre_fdg f12_split_face have dist_f12: "distinct (vertices f12)" by (auto intro: split_face_distinct1')

  then have removeNones_vol_edges_not_f12: " x y. x  set (removeNones vol)  (x,y)  edges f12" (* ? *)
    apply (drule_tac removeNones_vol_not_f12) by auto
  from dist_f12 have removeNones_vol_edges_not_f12': " x y. y  set (removeNones vol)  (x,y)  edges f12"
    apply (drule_tac removeNones_vol_not_f12) by auto

  from f12_fdg pre_fdg g' fdg have face_set_eq: " g'  {f} = {f12, f21}   g"
    apply (rule_tac splitFace_faces_1)
    by (simp_all)

  have rule5'': " a b. (a,b)  edges g'  (a,b)  edges g
      a  set (removeNones vol)  b  set (removeNones vol)  (a, b)  edges f21" (* ? *)
    apply (simp add: edges_graph_def) apply safe
    apply (case_tac "x = f") apply simp apply (rule rule5') apply safe
    apply (subgoal_tac "x   g'  {f}") apply (thin_tac "x  f")
    apply (thin_tac "x  set (faces g')") apply (simp only: add: face_set_eq)
    apply safe apply (drule removeNones_vol_edges_not_f12) by auto
 have rule5''': " a b. (a,b)  edges g'  (a,b)  edges g
      a  set (removeNones vol)  b  set (removeNones vol)  (a, b)  edges f21" (* ? *)

    apply (simp add: edges_graph_def) apply safe
    apply (case_tac "x = f") apply simp apply (rule rule5') apply safe
    apply (subgoal_tac "x   g'  {f}") apply (thin_tac "x  f")
    apply (thin_tac "x   g'") apply (simp only: add: face_set_eq)
    apply safe apply (drule removeNones_vol_edges_not_f12) by auto


 from pre_fdg fdg f12_fdg  g' have edges_g'1: "ws  []  edges g' = edges g  Edges ws  Edges(rev ws) 
   {(u, last ws), (hd ws, v), (v, hd ws), (last ws, u)}"
   apply (rule_tac splitFace_edges_g') apply simp
   apply (subgoal_tac "(f12, f21, g') = splitFace g v u f ws")  apply assumption by auto

 from pre_fdg fdg f12_fdg  g' have edges_g'2: "ws = []  edges g' = edges g 
   {(v, u), (u, v)}"
   apply (rule_tac splitFace_edges_g'_vs) apply simp
   apply (subgoal_tac "(f12, f21, g') = splitFace g v u f []")  apply assumption by auto


 from f12_split_face f21_split_face have split: "(f12,f21) = split_face f v u ws" by simp


  from pre_add have "¬ invalidVertexList g f vol"
    by (auto simp: pre_subdivFace'_def dest: invalidVertexList_shorten)
  then have rule5: "¬ invalidVertexList g' f21 vol"

    apply (simp add: invalidVertexList_def)
    apply (intro allI impI)
    apply (case_tac "vol!i")  apply simp+
    apply (case_tac "vol!Suc i") apply simp+
    apply (subgoal_tac "¬ is_duplicateEdge g f a aa")
     apply (thin_tac "i<|vol| - Suc 0. ¬ (case vol ! i of None  False
        | Some a  case_option False (is_duplicateEdge g f a) (vol ! (i+1)))")
     apply (simp add: is_duplicateEdge_def)
     apply (subgoal_tac "a  set (removeNones vol)  aa  set (removeNones vol)")
      apply (rule conjI)
       apply (rule impI)
       apply (case_tac "(a, aa)  edges f")
        apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (frule split_face_edges_or [OF split]) apply simp
         apply (simp add:  removeNones_vol_edges_not_f12)
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply (case_tac "(aa, a)  edges f")
        apply simp
        apply (subgoal_tac "pre_split_face f v u ws")
         apply (frule split_face_edges_or [OF split]) apply simp
         apply (simp add:  removeNones_vol_edges_not_f12)
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply simp
       apply (case_tac "ws = []") apply (frule edges_g'2)  apply simp
        apply (subgoal_tac "pre_split_face f v u []")
         apply (subgoal_tac "(f12, f21) = split_face f v u ws")
          apply (case_tac "between (vertices f) u v = []")
           apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
           apply simp
          apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
          apply (case_tac "a = v  aa = u") apply simp apply simp
         apply (rule split)
        apply (subgoal_tac "pre_split_face f v u ws") apply simp
        apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
       apply (frule edges_g'1) apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (subgoal_tac "(f12, f21) = split_face f v u ws")
         apply (case_tac "between (vertices f) u v = []")
          apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
          apply simp
          apply (case_tac "a = u  aa = last ws") apply simp apply simp
          apply (case_tac "a = hd ws  aa = v") apply simp apply simp
          apply (case_tac "a = v  aa = hd ws") apply simp apply simp
          apply (case_tac "a = last ws  aa = u") apply simp apply simp
          apply (case_tac "(a, aa)  Edges ws") apply simp
          apply simp
         apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
         apply (force)
        apply (rule split)
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (rule impI)
      apply (case_tac "(aa,a)  edges f") apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (frule split_face_edges_or [OF split]) apply simp
        apply (simp add:  removeNones_vol_edges_not_f12)
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (case_tac "(a,aa)  edges f") apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (frule split_face_edges_or [OF split]) apply simp
        apply (simp add:  removeNones_vol_edges_not_f12)
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply simp
      apply (case_tac "ws = []") apply (frule edges_g'2) apply simp
       apply (subgoal_tac "pre_split_face f v u []")
        apply (subgoal_tac "(f12, f21) = split_face f v u ws")
         apply (case_tac "between (vertices f) u v = []")
          apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
          apply simp
         apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
         apply force
        apply (rule split)
       apply (subgoal_tac "pre_split_face f v u ws") apply simp
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (frule edges_g'1) apply simp
      apply (subgoal_tac "pre_split_face f v u ws")
       apply (subgoal_tac "(f12, f21) = split_face f v u ws")
        apply (case_tac "between (vertices f) u v = []")
         apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
         apply (force)
        apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
        apply (force)
       apply (rule split)
      apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
     apply (rule conjI)
      apply (subgoal_tac "Some a  set vol") apply (induct vol) apply simp apply force
      apply (subgoal_tac "vol ! i  set vol") apply simp
      apply (rule nth_mem) apply arith
     apply (subgoal_tac "Some aa  set vol") apply (induct vol) apply simp apply force
     apply (subgoal_tac "vol ! (Suc i)  set vol") apply simp apply (rule nth_mem) apply arith
    by auto


  from pre_fdg dist_f21 v' have dists: "distinct (vertices f)"  "distinct (vertices f12)"
     "distinct (vertices f21)"  "v'  𝒱 f"
    apply auto defer
    apply (drule splitFace_distinct2) apply (simp add: f12_fdg)
    apply (unfold pre_splitFace_def) by simp
  with pre_fdg have edges_or: " a b. (a,b)  edges f  (a,b)  edges f12  (a,b)  edges f21"
    apply (rule_tac split_face_edges_or) apply (simp add: f12_split_face f21_split_face)
   by simp+

 from pre_fdg have dist_f: "distinct (vertices f)" apply (unfold pre_splitFace_def) by simp

(* lemma *)
 from g' have edges_g': "edges g'
    = (UN h:set(replace f [snd (split_face f v u ws)] (faces g)). edges h)
     edges (fst (split_face f v u ws))"
  by (auto simp add: splitFace_def split_def edges_graph_def)


(* lemma *)
 from pre_fdg edges_g' have edges_g'_or:
   " a b. (a,b)  edges g' 
    (a,b)  edges g  (a,b)  edges f12  (a,b)  edges f21"
   apply simp apply (case_tac "(a, b)  edges (fst (split_face f v u ws))")
   apply (simp add:f12_split_face) apply simp
   apply (elim bexE) apply (simp add: f12_split_face) apply (case_tac "x   g")
   apply (induct g) apply (simp  add: edges_graph_def) apply (rule disjI1)
   apply (rule bexI) apply simp apply simp
   apply (drule replace1) apply simp by (simp add: f21_split_face)

  have rule6: "0 < |vol|  ¬ invalidVertexList g f (Some u # vol) 
    (y. hd vol = Some y)  ¬ is_duplicateEdge g' f21 u (the (hd vol))"

    apply (rule impI)
    apply (erule exE) apply simp apply (case_tac vol) apply simp+
    apply (simp add: invalidVertexList_def) apply (erule allE) apply (erule impE) apply force
    apply (simp)
    apply (subgoal_tac "y  𝒱 f12") defer apply (rule removeNones_vol_not_f12) apply simp
    apply (simp add: is_duplicateEdge_def)
    apply (subgoal_tac "y  set (removeNones vol)")
     apply (rule conjI)
      apply (rule impI)
      apply (case_tac "(u, y)  edges f") apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (frule split_face_edges_or [OF split]) apply simp
        apply (simp add:  removeNones_vol_edges_not_f12')
       apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
      apply (case_tac "(y, u)  edges f") apply simp
       apply (subgoal_tac "pre_split_face f v u ws")
        apply (frule split_face_edges_or [OF split]) apply simp
        apply (simp add:  removeNones_vol_edges_not_f12)
       apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
      apply simp
      apply (case_tac "ws = []") apply (frule edges_g'2)  apply simp
       apply (subgoal_tac "pre_split_face f v u []")
        apply (subgoal_tac "(f12, f21) = split_face f v u ws")
         apply (case_tac "between (vertices f) u v = []")
          apply (frule split_face_edges_f21_bet_vs) apply simp apply simp apply simp
         apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
         apply force
        apply (rule split)
       apply (subgoal_tac "pre_split_face f v u ws") apply simp
       apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
      apply (frule edges_g'1) apply simp
      apply (subgoal_tac "pre_split_face f v u ws")
       apply (subgoal_tac "(f12, f21) = split_face f v u ws")
        apply (case_tac "between (vertices f) u v = []")
         apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
         apply (force)
        apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
        apply (force)
       apply (rule split)
      apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
     apply (rule impI)
     apply (case_tac "(u, y)  edges f") apply simp
     apply (subgoal_tac "pre_split_face f v u ws")
      apply (frule split_face_edges_or [OF split]) apply simp apply (simp add:  removeNones_vol_edges_not_f12')
      apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
     apply (case_tac "(y, u)  edges f") apply simp
      apply (subgoal_tac "pre_split_face f v u ws")
       apply (frule split_face_edges_or [OF split]) apply simp apply (simp add:  removeNones_vol_edges_not_f12)
      apply (rule pre_splitFace_pre_split_face) apply simp  apply (rule pre_fdg)
     apply simp
     apply (case_tac "ws = []") apply (frule edges_g'2)  apply simp
      apply (subgoal_tac "pre_split_face f v u []")
       apply (subgoal_tac "(f12, f21) = split_face f v u ws")
        apply (case_tac "between (vertices f) u v = []")
         apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
         apply simp
        apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
        apply force
       apply (rule split)
      apply (subgoal_tac "pre_split_face f v u ws") apply simp
      apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
     apply (frule edges_g'1) apply simp
     apply (subgoal_tac "pre_split_face f v u ws")
      apply (subgoal_tac "(f12, f21) = split_face f v u ws")
       apply (case_tac "between (vertices f) u v = []")
        apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
        apply (force)
       apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
       apply (force)
      apply (rule split)
     apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
    by simp
  have u21: "u  𝒱 f21" by(simp add:f21)
  from fdg have "¬ final f21"
    by(simp add:splitFace_def split_face_def split_def)
  with pre_add rule1 rule2 rule3 rule4 rule5 rule6 dist_f21 False dist u21
  show ?thesis by (simp_all add: pre_subdivFace'_def l)
qed


lemma before_filter: "  ys. filter P xs = ys  distinct xs  before ys  u v  before xs u v"
  supply subst_all [simp del]
  apply (subgoal_tac "P u")
  apply (subgoal_tac "P v")
  apply (subgoal_tac "pre_between xs u v")
  apply (rule ccontr) apply (simp add: before_xor)
  apply (subgoal_tac "before ys v u")
  apply (subgoal_tac "¬ before ys v u")
  apply simp
  apply (rule before_dist_not1) apply force apply simp
  apply (simp add: before_def) apply (elim exE) apply simp
  apply (subgoal_tac "a @ u # b @ v # c = filter P aa @ v # filter P ba @ u # filter P ca")
  apply (intro exI) apply assumption
  apply simp
  apply (subgoal_tac "u  set ys  v  set ys  u  v") apply (simp add: pre_between_def) apply force
  apply (subgoal_tac "distinct ys")
  apply (simp add: before_def) apply (elim exE) apply simp
  apply force
  apply (subgoal_tac "v  set (filter P xs)") apply force
  apply (simp add: before_def) apply (elim exE) apply simp
  apply (subgoal_tac "u  set (filter P xs)") apply force
  apply (simp add: before_def) apply (elim exE) by simp


lemma pre_subdivFace'_Some2: "pre_subdivFace' g f v' v 0 ((Some u) # vol)  pre_subdivFace' g f v' u 0 vol"
apply (cases "vol = []")
 apply (simp add: pre_subdivFace'_def)
  apply (cases "u = v'") apply simp
 apply(rule verticesFrom_in')
  apply(rule last_in_set)
  apply(simp add:verticesFrom_Def)
 apply clarsimp
apply (simp add: pre_subdivFace'_def)
apply (elim conjE)
apply (thin_tac "v' = v  u  last (verticesFrom f v')  v'  v")
apply auto
    apply(rule verticesFrom_in'[where v = v'])
     apply(clarsimp simp:before_def)
    apply simp
   apply (rule ovl_shorten) apply simp
   apply (subgoal_tac "[v  verticesFrom f v' . v  set (removeNones ((Some u) # vol))] = removeNones ((Some u) # vol)")
    apply assumption
   apply simp
  apply (rule before_filter)
    apply assumption
   apply simp
  apply (simp add: before_def)
  apply (intro exI)
  apply (subgoal_tac "u # removeNones vol = [] @ u # [] @ hd (removeNones vol) # tl (removeNones vol)") apply assumption
  apply simp
  apply (subgoal_tac "removeNones vol  []") apply simp
  apply (cases vol rule: rev_exhaust) apply simp_all
 apply (simp add: invalidVertexList_shorten)
apply (simp add: is_duplicateEdge_def)
apply (case_tac "vol") apply simp
apply simp
apply (simp add: invalidVertexList_def)
apply (elim allE)
apply (rotate_tac -1)
apply (erule impE)
 apply (subgoal_tac "0 < Suc |list|")
  apply assumption
 apply simp
apply simp
by (simp add: is_duplicateEdge_def)

lemma pre_subdivFace'_preFaceDiv: "pre_subdivFace' g f v' v n ((Some u) # vol)
   f   g  (f  v = u  n  0)  𝒱 f  𝒱 g
   pre_splitFace g v u f [countVertices g ..< countVertices g + n]"
proof -
  assume pre_add: "pre_subdivFace' g f v' v n ((Some u) # vol)" and f: "f   g"
  and nextVert: "(f  v = u  n  0)" and subset: "𝒱 f  𝒱 g"
  have "distinct [countVertices g ..< countVertices g + n]" by (induct n) auto
  moreover
  have "𝒱 g  set [countVertices g ..< countVertices g + n] = {}"
    apply (cases g) by auto
  with subset have "𝒱 f  set [countVertices g ..< countVertices g + n] = {}" by auto
  moreover
  from pre_add have "𝒱 f = set (verticesFrom f v')" apply (intro congs_pres_nodes verticesFrom_congs)
    by (simp add: pre_subdivFace'_def)
  with pre_add have "help": "v  𝒱 f  u  𝒱 f  v  u"
    apply (simp add: pre_subdivFace'_def before_def)
    apply (elim conjE exE)
    apply (subgoal_tac "distinct (verticesFrom f v')") apply force
    apply (rule verticesFrom_distinct) by simp_all
  moreover
  from "help" pre_add nextVert have help1: "is_nextElem (vertices f) v u  0 < n" apply auto
    apply (simp add: nextVertex_def)
    by (simp add: nextElem_is_nextElem pre_subdivFace'_def)
  moreover
 have help2: "before (verticesFrom f v') v u  distinct (verticesFrom f v')  v  v'  ¬ is_nextElem (verticesFrom f v') u v"
   apply (simp add: before_def is_nextElem_def verticesFrom_hd is_sublist_def) apply safe
   apply (frule dist_at)
   apply simp
   apply (thin_tac "verticesFrom f v' = a @ v # b @ u # c")
   apply (subgoal_tac "verticesFrom f v' = (as @ [u]) @ v # bs") apply assumption
   apply simp apply (subgoal_tac "distinct (a @ v # b @ u # c)") apply force by simp
  note pre_add f
  moreover(*
  have "⋀ m. {k. k < m} ∩ {k. m ≤ k ∧ k < (m + n)} = {}" by auto
  moreover*)

  from pre_add f help2 help1 "help" have "[countVertices g..<countVertices g + n] = []  (v, u)  edges f  (u, v)  edges f"
    apply (cases "0 < n") apply (induct g) apply simp+
    apply (simp add: pre_subdivFace'_def)
    apply (rule conjI) apply force
    apply (simp split: if_split_asm)
     apply (rule ccontr)  apply simp
     apply (subgoal_tac "v = v'") apply simp  apply (elim conjE) apply (simp only:)
     apply (rule verticesFrom_is_nextElem_last) apply force apply force
     apply (simp add: verticesFrom_is_nextElem [symmetric])
    apply (cases "v = v'") apply simp
     apply (subgoal_tac "v'  𝒱 f")
      apply (thin_tac "u  𝒱 f")

      apply (simp add: verticesFrom_is_nextElem)
      apply (rule ccontr) apply simp
      apply (subgoal_tac "v'  𝒱 f")
       apply (drule verticesFrom_is_nextElem_hd) apply simp+

    apply (elim conjE) apply (drule help2)
      apply simp apply simp
    apply (subgoal_tac "is_nextElem (vertices f) u v = is_nextElem (verticesFrom f v') u v")
     apply simp
    apply (rule verticesFrom_is_nextElem) by simp
  ultimately

  show ?thesis
    apply (simp add: pre_subdivFace'_def)
    apply (unfold pre_splitFace_def)
    apply simp
    apply (cases "0 < n") apply (induct g) apply (simp add: ivl_disj_int)
    apply (auto simp: invalidVertexList_def is_duplicateEdge_def)
    done
qed


lemma pre_subdivFace'_Some1:
  "pre_subdivFace' g f v' v n ((Some u) # vol)
   f   g  (f  v = u  n  0)  𝒱 f  𝒱 g
   f21 = fst (snd (splitFace g v u f [countVertices g ..< countVertices g + n]))
   g' =  snd (snd (splitFace g v u f [countVertices g ..< countVertices g + n]))
   pre_subdivFace' g' f21 v' u 0 vol"
  apply (subgoal_tac "pre_splitFace g v u f [countVertices g ..< countVertices g + n]")
   apply (rule pre_subdivFace'_Some1') apply assumption+
  apply (simp)
  apply (rule pre_subdivFace'_preFaceDiv)
  by auto

end

Theory Invariants

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section‹Invariants of (Plane) Graphs›

theory Invariants
imports FaceDivisionProps
begin

subsection‹Rotation of face into normal form›

definition minVertex :: "face  vertex" where
"minVertex f  min_list (vertices f)"

(* FIXME define normFace via rotate_min *)
definition normFace :: "face  vertex list" where
"normFace  λf. verticesFrom f (minVertex f)"

definition normFaces :: "face list  vertex list list" where
"normFaces fl  map normFace fl"

lemma normFaces_distinct:  "distinct (normFaces fl)  distinct fl"
apply (induct fl) by (auto simp: normFace_def normFaces_def)


(***********************************************************************)

subsection ‹Minimal (plane) graph properties›

definition minGraphProps' :: "graph  bool" where
  "minGraphProps' g  f   g. 2 < |vertices f|  distinct (vertices f)"

definition edges_sym :: "graph  bool" where
"edges_sym g   a b. (a,b)  edges g  (b,a)  edges g"

definition faceListAt_len :: "graph  bool" where
"faceListAt_len g  (length (faceListAt g) = countVertices g)"

definition facesAt_eq :: "graph  bool" where
"facesAt_eq g  v  𝒱 g. set(facesAt g v) = {f. f   g  v  𝒱 f}"

definition facesAt_distinct :: "graph  bool" where
"facesAt_distinct g  v  𝒱 g. distinct (normFaces (facesAt g  v))"

definition faces_distinct :: "graph  bool" where
"faces_distinct g  distinct (normFaces (faces g))"

definition faces_subset :: "graph  bool" where
"faces_subset g  f   g. 𝒱 f  𝒱 g"

definition edges_disj :: "graph  bool" where
"edges_disj g 
 f   g. f'   g. f  f'   f   f' = {}"

definition face_face_op :: "graph  bool" where
"face_face_op g  |faces g|  2 
 (f g. f' g. f  f'   f  ( f')¯)"

definition one_final_but :: "graph  (vertex × vertex)set  bool" where
"one_final_but g E 
 f   g. ¬ final f 
   ((a,b) f - E. (b,a) : E  (f' g. final f'  (b,a)   f'))"

definition one_final :: "graph  bool" where
"one_final g  one_final_but g {}"


definition minGraphProps :: "graph  bool" where
"minGraphProps g  minGraphProps' g  facesAt_eq g  faceListAt_len g  facesAt_distinct g  faces_distinct g  faces_subset g  edges_sym g  edges_disj g  face_face_op g"

definition inv :: "graph  bool" where
"inv g  minGraphProps g  one_final g  |faces g|  2"


lemma facesAt_distinctI:
  "(v. v  𝒱 g  distinct (normFaces (facesAt g  v)))  facesAt_distinct g"
 by (simp add: facesAt_distinct_def)

(* minGraphProps' *)
lemma minGraphProps2:
  "minGraphProps g  f   g  2 < |vertices f|"
by (unfold minGraphProps_def minGraphProps'_def) auto

lemma mgp_vertices3:
  "minGraphProps g  f   g  |vertices f|  3"
by(auto dest:minGraphProps2)

lemma mgp_vertices_nonempty:
  "minGraphProps g  f   g  vertices f  []"
by(auto dest:minGraphProps2)

lemma minGraphProps3:
  "minGraphProps g  f   g   distinct (vertices f)"
by (unfold minGraphProps_def minGraphProps'_def) auto

(* faceListAt_len *)
lemma minGraphProps4:
  "minGraphProps g  (length (faceListAt g) = countVertices g)"
by (unfold minGraphProps_def faceListAt_len_def) simp

(* facesAt_eq*)
lemma minGraphProps5:
  "minGraphProps g; v : 𝒱 g; f  set (facesAt g v)  f   g"
by(auto simp: facesAt_def facesAt_eq_def minGraphProps_def minGraphProps'_def
              faceListAt_len_def split:if_split_asm)

lemma minGraphProps6:
  "minGraphProps g  v : 𝒱 g  f  set (facesAt g v)  v  𝒱 f"
by(auto simp: facesAt_def facesAt_eq_def minGraphProps_def minGraphProps'_def
              faceListAt_len_def split:if_split_asm)

(* faces_subset *)
lemma minGraphProps9:
  "minGraphProps g  f   g  v  𝒱 f  v  𝒱 g"
by (unfold minGraphProps_def faces_subset_def) auto

lemma minGraphProps7:
  "minGraphProps g  f   g  v  𝒱 f   f  set (facesAt g v)"
apply(frule (2) minGraphProps9)
by (unfold minGraphProps_def facesAt_eq_def) simp

lemma minGraphProps_facesAt_eq: "minGraphProps g 
  v  𝒱 g  set (facesAt g v) = {f   g. v  𝒱 f}"
by (simp add: minGraphProps_def facesAt_eq_def)

(* facesAt_distinct *)
lemma mgp_dist_facesAt[simp]:
  "minGraphProps g  v : 𝒱 g  distinct (facesAt g v)"
by(auto simp: facesAt_def minGraphProps_def minGraphProps'_def facesAt_distinct_def dest:normFaces_distinct)

lemma minGraphProps8:
  "minGraphProps g  v : 𝒱 g  distinct (normFaces (facesAt g v))"
by(auto simp: facesAt_def minGraphProps_def minGraphProps'_def facesAt_distinct_def normFaces_def)

lemma minGraphProps8a:
  "minGraphProps g  v  𝒱 g  distinct (normFaces (faceListAt g ! v))"
apply (frule (1) minGraphProps8[where v=v]) by (simp add: facesAt_def)

lemma minGraphProps8a': "minGraphProps g 
  v < countVertices g  distinct (normFaces (faceListAt g ! v))"
by (simp add: minGraphProps8a vertices_graph)

lemma minGraphProps9':
  "minGraphProps g  f   g  v  𝒱 f  v < countVertices g"
by (simp add: minGraphProps9 in_vertices_graph[symmetric])

lemma minGraphProps10:
  "minGraphProps g  (a, b)  edges g  (b, a)  edges g"
apply (unfold minGraphProps_def edges_sym_def)
apply (elim conjE allE impE)
by simp+

(* faces_distinct *)
lemma minGraphProps11:
  "minGraphProps g  distinct (normFaces (faces g))"
by (unfold minGraphProps_def faces_distinct_def) simp

lemma minGraphProps11':
  "minGraphProps g  distinct (faces g)"
by(simp add: minGraphProps11 normFaces_distinct)

lemma minGraphProps12:
  "minGraphProps g  f   g  (a,b)   f  (b,a)   f"
apply (subgoal_tac "distinct (vertices f)") apply (simp add: is_nextElem_def)
 apply (case_tac "vertices f = []")
  apply (drule minGraphProps2)
   apply simp
  apply simp
 apply simp
 apply (case_tac "a = last (vertices f)  b = hd (vertices f)")
  apply (case_tac "vertices f") apply simp
  apply (case_tac "list" rule: rev_exhaust)
   apply (drule minGraphProps2) apply simp
   apply simp
  apply (case_tac "ys")
   apply (drule minGraphProps2) apply simp apply simp
  apply (simp del: distinct_append distinct.simps)
  apply (rule conjI)
   apply (rule ccontr) apply (simp del: distinct_append distinct.simps)
   apply (drule is_sublist_distinct_prefix) apply simp
   apply (simp add: is_prefix_def)
  apply simp
 apply (rule conjI)
  apply (simp add: is_sublist_def) apply (elim exE) apply (intro allI) apply (rule ccontr)
  apply (simp del: distinct_append distinct.simps)
  apply (subgoal_tac "asa = as @ [a]") apply simp
  apply (rule dist_at1) apply assumption apply force apply (rule sym) apply simp
 apply (subgoal_tac "is_sublist [a, b] (vertices f)")
  apply (rule impI) apply (rule ccontr)
  apply (simp add: is_sublist_def del: distinct_append distinct.simps)
  apply (subgoal_tac "last (vertices f) = b  hd (vertices f) = a")
   apply (thin_tac "a = hd (vertices f)") apply (thin_tac "b = last (vertices f)") apply (elim conjE)
   apply (elim exE)
   apply (case_tac "as")
    apply (case_tac "bs" rule: rev_exhaust) apply (drule minGraphProps2) apply simp apply simp
    apply simp+
apply (rule minGraphProps3) by simp+

lemma minGraphProps7': "minGraphProps g 
  f   g  v  𝒱 f   f  set (faceListAt g ! v)"
apply (frule minGraphProps7) apply assumption+
by (simp add: facesAt_def split: if_split_asm)

(* edges_disj *)
lemma mgp_edges_disj:
 " minGraphProps g; f  f'; f   g; f'   g  
  uv   f  uv   f'"
by (simp add:minGraphProps_def edges_disj_def) blast

(* one_final *)
lemma one_final_but_antimono:
  "one_final_but g E  E  E'  one_final_but g E'"
apply(unfold one_final_but_def)
apply blast
done

lemma one_final_antimono: "one_final g  one_final_but g E"
apply(unfold one_final_def one_final_but_def)
apply blast
done

lemma inv_two_faces: "inv g  |faces g|  2"
by(simp add:inv_def)

lemma inv_mgp[simp]: "inv g  minGraphProps g"
by(simp add:inv_def)

lemma makeFaceFinal_id[simp]: "final f  makeFaceFinal f g = g"
apply(cases g)
apply (simp add:makeFaceFinal_def makeFaceFinalFaceList_def
                setFinal_eq_iff[THEN iffD2])
done

lemma inv_one_finalD':
 " inv g; f   g; ¬ final f; (a,b)   f  
  f'   g. final f'  f'  f  (b,a)   f'"
apply(unfold inv_def one_final_def one_final_but_def)
apply blast
done

lemmas minGraphProps =
  minGraphProps2 minGraphProps3 minGraphProps4
  minGraphProps5 minGraphProps6 minGraphProps7 minGraphProps8
  minGraphProps9

lemma mgp_no_loop[simp]:
  "minGraphProps g  f   g  v  𝒱 f  f  v  v"
apply(frule (1) mgp_vertices3)
apply(frule (1) minGraphProps3)
apply(simp add: distinct_no_loop1)
done

lemma mgp_facesAt_no_loop:
  "minGraphProps g  v : 𝒱 g  f  set (facesAt g v)  f  v  v"
by(blast dest:mgp_no_loop minGraphProps5 minGraphProps6)

lemma edge_pres_faceAt:
 " minGraphProps g; u : 𝒱 g; f  set(facesAt g u); (u,v)   f  
  f  set(facesAt g v)"
apply(auto simp:edges_face_eq)
apply(rule minGraphProps7, assumption)
 apply(blast intro:minGraphProps)
apply(simp)
done

lemma in_facesAt_nextVertex:
 "minGraphProps g  v : 𝒱 g  f  set(facesAt g v)  f  set(facesAt g (f  v))"
apply(subgoal_tac "(v,f  v)   f")
 apply(blast intro:edge_pres_faceAt)
by(blast intro: nextVertex_in_edges minGraphProps)


lemma mgp_edge_face_ex:
assumes [intro]: "minGraphProps g" "v : 𝒱 g"
and fv: "f  set(facesAt g v)" and uv: "(u,v)   f"
shows "f'  set(facesAt g v). (v,u)   f'"
proof -
  from fv have "f   g" by(blast intro:minGraphProps)
  with uv have "(u,v)   g" by(auto simp:edges_graph_def)
  hence "(v,u)   g" by(blast intro:minGraphProps10)
  then obtain f' where f': "f'   g" and vu: "(v,u)   f'"
    by(auto simp:edges_graph_def)
  from vu have "v  𝒱 f'" by(auto simp:edges_face_eq)
  with f' have "f'  set(facesAt g v)" by(blast intro:minGraphProps)
  with vu show ?thesis by blast
qed

lemma nextVertex_in_graph:
  "minGraphProps g  v : 𝒱 g  f  set(facesAt g v)  f  v : 𝒱 g"
by(blast intro: minGraphProps9 minGraphProps5 minGraphProps6 nextVertex_in_face)

lemma mgp_nextVertex_face_ex2:
assumes mgp[intro]: "minGraphProps g" "v : 𝒱 g" and f: "f  set(facesAt g v)"
shows "f'  set(facesAt g (f  v)). f'  (f  v) = v"
proof -
  from f have "(v,f  v)   f"
    by(blast intro: nextVertex_in_edges minGraphProps)
  with in_facesAt_nextVertex[OF mgp f]
    mgp_edge_face_ex[OF mgp(1) nextVertex_in_graph[OF mgp f]]
  obtain f' :: face where "f'  set(facesAt g (f  v))"
    and "(f  v,v)   f'"
    by(blast)
  thus ?thesis by (auto simp: edges_face_eq)
qed


lemma inv_finals_nonempty: "inv g  finals g  []"
apply(frule inv_two_faces)
apply(clarsimp simp:filter_empty_conv finals_def)
apply(subgoal_tac "faces g  []")
 prefer 2 apply clarsimp
apply(simp add:neq_Nil_conv)
apply clarify
apply(rename_tac f fs)
apply(case_tac "final f")
 apply simp
apply(frule mgp_vertices_nonempty[OF inv_mgp])
 apply fastforce
apply(clarsimp simp:neq_Nil_conv)
apply(rename_tac v vs)
apply(subgoal_tac "v  𝒱 f")
 prefer 2 apply simp
apply(drule nextVertex_in_edges)
apply(drule inv_one_finalD')
   prefer 2 apply assumption
  apply simp
 apply assumption
apply(auto)
done


subsection @{const containsDuplicateEdge}

definition
 containsUnacceptableEdgeSnd' :: "(nat  nat  bool)  nat list  bool" where
"containsUnacceptableEdgeSnd' N is 
 (k < |is| - 2. let i0 = is!k; i1 = is!(k+1); i2 = is!(k+2) in
 N i1 i2  (i0 < i1)  (i1 < i2))"

lemma containsUnacceptableEdgeSnd_eq:
  "containsUnacceptableEdgeSnd N v is = containsUnacceptableEdgeSnd' N (v#is)"
proof (induct "is" arbitrary: v)
  case Nil then show ?case by (simp add: containsUnacceptableEdgeSnd'_def)
next
  case (Cons i "is") then show ?case
    proof (rule_tac iffI)
      assume vors: "containsUnacceptableEdgeSnd N v (i # is)"
      then show "containsUnacceptableEdgeSnd' N (v # i # is)"
        apply (cases "is") apply simp apply simp
        apply (simp split: if_split_asm del: containsUnacceptableEdgeSnd.simps)
         apply (simp add: containsUnacceptableEdgeSnd'_def) apply force
        apply (subgoal_tac "a # list = is") apply (thin_tac "is = a # list") apply (simp add: Cons)
         apply (simp add: containsUnacceptableEdgeSnd'_def) apply (elim exE)
         apply (rule exI) apply (subgoal_tac "Suc k < |is|") apply (rule conjI) apply assumption by auto
    next
      assume vors: "containsUnacceptableEdgeSnd' N (v # i # is)"
      then show "containsUnacceptableEdgeSnd N v (i # is)"
        apply simp apply (cases "is") apply (simp add: containsUnacceptableEdgeSnd'_def)
        apply (simp del:  containsUnacceptableEdgeSnd.simps)
        apply (subgoal_tac "a # list = is") apply (thin_tac "is = a # list")
         apply (simp add: Cons)
         apply (subgoal_tac "is = a # list") apply (thin_tac "a # list = is")
          apply (simp add: containsUnacceptableEdgeSnd'_def)
          apply (elim exE) apply (case_tac "k") apply simp apply simp apply (intro impI exI)
          apply (rule conjI) apply (elim conjE) apply assumption by auto
    qed
qed

lemma containsDuplicateEdge_eq1:
  "containsDuplicateEdge g f v is = containsDuplicateEdge' g f v is"
apply (simp add: containsDuplicateEdge_def)
apply (cases "is") apply (simp add: containsDuplicateEdge'_def)
apply simp
apply (case_tac "list") apply (simp add: containsDuplicateEdge'_def)
apply (simp add: containsUnacceptableEdgeSnd_eq del: containsUnacceptableEdgeSnd.simps)
apply (rule conjI) apply (simp add: containsDuplicateEdge'_def)
apply (rule impI)
apply (case_tac "a < aa")
 by (simp_all add: containsDuplicateEdge'_def containsUnacceptableEdgeSnd'_def)

lemma containsDuplicateEdge_eq:
  "containsDuplicateEdge = containsDuplicateEdge'"
apply (rule ext)+
by (simp add: containsDuplicateEdge_eq1)


declare Nat.diff_is_0_eq' [simp del]


(********************************* replaceFacesAt ****************************)
subsection@{const replacefacesAt}

primrec replacefacesAt2 ::
  "nat list  face  face list  face list list  face list list" where
"replacefacesAt2 [] f fs F = F" |
"replacefacesAt2 (n#ns) f fs F =
 (if n < |F|
  then replacefacesAt2 ns f fs (F [n:=replace f fs (F!n)])
  else replacefacesAt2 ns f fs F)"


lemma replacefacesAt_eq[THEN eq_reflection]:
  "replacefacesAt ns oldf newfs F =  replacefacesAt2 ns oldf newfs F"
by (induct ns arbitrary: F) (auto simp add: replacefacesAt_def)


lemma replacefacesAt2_notin:
  "i  set is  (replacefacesAt2 is olfF newFs Fss)!i = Fss!i"
proof (induct "is" arbitrary: Fss)
  case Nil then show ?case by (simp)
next
  case (Cons j js) then show ?case
    by (cases "j < |Fss|") (auto)
qed


lemma replacefacesAt2_in:
  "i  set is  distinct is  i < |Fss| 
  (replacefacesAt2 is olfF newFs Fss)!i = replace olfF newFs (Fss !i)"
proof (induct "is" arbitrary: Fss)
  case Nil then show ?case by simp
next
  case (Cons j js)
  then have "j = i  i  set js  i  j  i  set js" by auto
  then show ?case
  proof (elim disjE conjE)
    assume "j = i" "i  set js" with Cons show ?thesis
    by (auto simp add: replacefacesAt2_notin)
  next
    assume "i  set js" "i  j" with Cons show ?thesis by simp
  qed
qed


lemma distinct_replacefacesAt21:
  "i < |Fss|  i  set is  distinct is  distinct (Fss!i)  distinct newFs 
  set (Fss ! i)  set newFs  {olfF} 
  distinct ((replacefacesAt2 is olfF newFs Fss)! i)"
proof (induct "is")
  case Nil then show ?case by simp
next
  case (Cons j js)
  then have "j = i  i  set js  i  j  i  set js" by auto
  then show ?case
  proof (elim disjE conjE)
    assume "j = i" "i  set js" with Cons show ?thesis
     by (simp add: replacefacesAt2_notin distinct_replace)
  next
    assume "i  set js" "i  j" with Cons show ?thesis
     by (simp add: replacefacesAt2_in distinct_replace)
  qed
qed

lemma distinct_replacefacesAt22:
  "i < |Fss|  i  set is  distinct is  distinct (Fss!i)  distinct newFs 
  set (Fss ! i)  set newFs  {olfF} 
  distinct ((replacefacesAt2 is olfF newFs Fss)! i)"
proof (induct "is")
  case Nil then show ?case by simp
next
  case (Cons j js)
  then have "i  j" by auto
  with Cons show ?case
    by (simp add: replacefacesAt2_notin distinct_replace)
qed

lemma distinct_replacefacesAt2_2:
  "i < |Fss|  distinct is  distinct (Fss!i)  distinct newFs 
  set (Fss ! i)  set newFs  {olfF} 
  distinct ((replacefacesAt2 is olfF newFs Fss)! i)"
by (cases "i  set is")
   (auto intro: distinct_replacefacesAt21 distinct_replacefacesAt22)

lemma replacefacesAt2_nth1:
  "k  set ns  (replacefacesAt2 ns oldf newfs F) ! k  =  F ! k"
by (induct ns arbitrary: F) auto

lemma  replacefacesAt2_nth1': "k  set ns  k < |F|  distinct ns 
  (replacefacesAt2 ns oldf newfs F) ! k  =  (replace oldf newfs (F!k))"
apply (induct ns arbitrary: F)
 apply auto
 apply (simp add: replacefacesAt2_nth1)+
by (case_tac "a = k") auto


lemma replacefacesAt2_nth2: "k < |F| 
  (replacefacesAt2 [k] oldf newfs F) ! k = replace oldf newfs (F!k)"
by (auto)

lemma replacefacesAt2_length[simp]:
  "|replacefacesAt2 nvs f' f'' vs| = |vs|"
by (induct nvs arbitrary: vs) simp_all

lemma replacefacesAt2_nth: "k   set ns  k < |F|  oldf  set newfs  
  distinct (F!k)  distinct newfs  oldf  set (F!k)  set newfs  set (F!k)  {oldf} 
  (replacefacesAt2 ns oldf newfs F) ! k  =  (replace  oldf newfs (F!k))"
proof (induct ns arbitrary: F)
  case Nil then show ?case by simp
next
  case (Cons n ns) then show ?case
    apply (simp only: replacefacesAt2.simps)
    apply simp apply (case_tac "n = k")
     apply (simp)
     apply (subgoal_tac "replacefacesAt2 ns oldf newfs (F[k := replace  oldf newfs (F ! k)])  ! k =
    replace oldf newfs ((F[k := replace oldf newfs (F ! k)]) ! k)")
      apply simp
     apply (case_tac "k  set ns")  apply (rule Cons) apply simp+
        apply (rule replace_distinct) apply simp  apply simp
        apply simp
       apply simp
      apply (simp add:distinct_set_replace)
     apply (simp add:  replacefacesAt2_nth1)
    by simp
qed


lemma replacefacesAt_notin:
  "i  set is  (replacefacesAt is olfF newFs Fss)!i = Fss!i"
by (simp add: replacefacesAt_eq replacefacesAt2_notin)

lemma replacefacesAt_in:
  "i  set is  distinct is  i < |Fss| 
  (replacefacesAt is olfF newFs Fss)!i = replace olfF newFs (Fss !i)"
by (simp add: replacefacesAt_eq replacefacesAt2_in)

lemma replacefacesAt_length[simp]: "|replacefacesAt nvs f' [f''] vs| = |vs|"
by (simp add: replacefacesAt_eq)

lemma replacefacesAt_nth2: "k < |F| 
  (replacefacesAt [k] oldf newfs F) ! k = replace oldf newfs (F!k)"
by (simp add: replacefacesAt_eq replacefacesAt2_nth2)

lemma replacefacesAt_nth: "k   set ns  k < |F|  oldf  set newfs  
  distinct (F!k)  distinct newfs  oldf  set (F!k)  set newfs  set (F!k)  {oldf} 
  (replacefacesAt ns oldf newfs F) ! k  =  (replace  oldf newfs (F!k))"
by (simp add: replacefacesAt_eq replacefacesAt2_nth)

lemma replacefacesAt2_5: "x  set (replacefacesAt2 ns oldf newfs F ! k)  x  set (F!k)  x  set newfs"
proof (induct ns arbitrary: F)
  case Nil then show ?case by simp
next
  case (Cons n ns)
  then show ?case
    apply(simp add: split: if_split_asm ) apply (frule Cons)
    apply (thin_tac "F. x  set (replacefacesAt2 ns oldf newfs F ! k)  x  set (F ! k)  x  set newfs")
    apply (case_tac "x  set newfs")  apply simp apply simp
    apply (case_tac "k = n") apply simp apply (frule replace5) apply simp by simp
qed


lemma replacefacesAt_Nil[simp]: "replacefacesAt [] f fs F = F"
by (simp add: replacefacesAt_eq)

lemma replacefacesAt_Cons[simp]:
 "replacefacesAt (n # ns) f fs F =
  (if n < |F| then replacefacesAt ns f fs (F[n := replace f fs (F!n)])
   else replacefacesAt ns f fs F)"
by (simp add: replacefacesAt_eq)

lemmas replacefacesAt_simps = replacefacesAt_Nil replacefacesAt_Cons

lemma len_nth_repAt[simp]:
"xs. i < |xs|  |replacefacesAt is x [y] xs ! i| = |xs!i|"
by (induct "is") (simp_all add: add:nth_list_update)


subsection@{const normFace}

(************************** min_list & minVertex **********************)

lemma minVertex_in: "vertices f  []  minVertex f  𝒱 f"
by (simp add: minVertex_def)


lemma minVertex_eq_if_vertices_eq:
 "𝒱 f = 𝒱 f'  minVertex f = minVertex f'"
apply(cases f)
apply(cases f')
apply(rename_tac vs ft vs' ft')
apply(case_tac "vs = []")
 apply(simp add:vertices_face_def minVertex_def)
apply(subgoal_tac "vs'  []")
 prefer 2 apply clarsimp
apply(simp add:vertices_face_def minVertex_def min_list_conv_Min
               insert_absorb del:Min_insert)
done


(************** normFace ***************************)


lemma normFace_replace_in:
 "normFace a  set (normFaces (replace oldF newFs fs)) 
  normFace a  set (normFaces newFs)  normFace a  set (normFaces fs)"
apply (induct fs) apply simp
apply (auto simp add: normFaces_def split:if_split_asm)
done

lemma distinct_replace_norm:
  "distinct (normFaces fs)   distinct (normFaces newFs) 
   set (normFaces fs)  set (normFaces newFs)  {}  distinct (normFaces (replace oldF newFs fs))"
apply (induct fs) apply simp
apply simp
apply (case_tac "a = oldF") apply (simp add: normFaces_def) apply blast
apply (simp add: normFaces_def) apply (rule ccontr)
apply (subgoal_tac "normFace a  set(normFaces (replace oldF newFs fs))")
apply (frule normFace_replace_in)
 by (simp add: normFaces_def)+


lemma distinct_replacefacesAt1_norm:
  "i < |Fss|  i  set is  distinct is  distinct (normFaces (Fss!i))  distinct (normFaces newFs) 
  set (normFaces (Fss ! i))  set (normFaces newFs)  {} 
  distinct (normFaces ((replacefacesAt is oldF newFs Fss)! i))"
proof (induct "is")
  case Nil then show ?case by simp
next
  case (Cons j js)
  then have "j = i  i  set js  i  j  i  set js" by auto
  then show ?case
  proof (elim disjE conjE)
    assume "j = i" "i  set js" with Cons show ?thesis
     by (simp add: replacefacesAt_notin distinct_replace_norm)
  next
    assume "i  set js" "i  j" with Cons show ?thesis
     by (simp add: replacefacesAt_in distinct_replace_norm)
  qed
qed

lemma distinct_replacefacesAt2_norm:
  "i < |Fss|  i  set is  distinct is  distinct (normFaces (Fss!i))  distinct (normFaces newFs) 
  set (normFaces (Fss ! i))  set (normFaces newFs)  {} 
  distinct (normFaces ((replacefacesAt is oldF newFs Fss)! i))"
proof (induct "is")
  case Nil then show ?case by simp
next
  case (Cons j js)
  then have "i  j" by auto
  with Cons show ?case
    by (simp add: replacefacesAt_notin distinct_replace_norm)
qed

lemma distinct_replacefacesAt_norm:
  "i < |Fss|  distinct is  distinct (normFaces (Fss!i))  distinct (normFaces newFs) 
  set (normFaces (Fss ! i))  set (normFaces newFs)  {} 
  distinct (normFaces ((replacefacesAt is olfF newFs Fss)! i))"
by (cases "i  set is")
   (auto intro: distinct_replacefacesAt1_norm distinct_replacefacesAt2_norm)


lemma normFace_in_cong:
 "vertices f  []  minGraphProps g  normFace f  set (normFaces (faces g))
    f'  set (faces g). f  f'"
apply (simp add: normFace_def normFaces_def)
apply (erule imageE)
apply(rename_tac f')
apply (rule bexI)
 defer apply assumption
apply (simp add: cong_face_def)
 apply (rule congs_trans) apply (rule verticesFrom_congs)
 apply (rule minVertex_in) apply simp
apply (rule congs_sym) apply (simp add: normFace_def)
apply (rule verticesFrom_congs) apply (rule minVertex_in)
apply (subgoal_tac "2 < | vertices f'|") apply force
by (simp add: minGraphProps2)

lemma normFace_neq:
  "a  𝒱 f  a  𝒱 f'  vertices f'  []  normFace f  normFace f'"
apply (simp add: normFace_def)
apply (subgoal_tac "a  set (verticesFrom f (minVertex f))")
 apply (subgoal_tac "a  set (verticesFrom f' (minVertex f'))") apply force
 apply (subgoal_tac "(vertices f')  (verticesFrom f' (minVertex f'))") apply (simp add: congs_pres_nodes)
 apply (rule verticesFrom_congs) apply (rule minVertex_in) apply simp
apply (subgoal_tac "(vertices f)  (verticesFrom f (minVertex f))") apply (simp add: congs_pres_nodes)
apply (rule verticesFrom_congs) apply (rule minVertex_in) by auto

lemma split_face_f12_f21_neq_norm:
  "pre_split_face oldF ram1 ram2 vs 
  2 < |vertices oldF|  2 < |vertices f12|  2 < |vertices f21| 
  (f12, f21) = split_face oldF ram1 ram2 vs  normFace f12  normFace f21"
proof -
  assume split: "(f12, f21) = split_face oldF ram1 ram2 vs"
  "pre_split_face oldF ram1 ram2 vs"
    and minlen: "2 < |vertices oldF|"  "2 < | vertices f12|"  "2 < | vertices f21|"
  from split have dist_f12: "distinct (vertices f12)" by (rule split_face_distinct1)
  from split have dist_f21: "distinct (vertices f21)" by (rule split_face_distinct2)

  from split dist_f12 dist_f21 minlen show ?thesis
    apply (simp add: split_face_def)
    apply (case_tac "between (vertices oldF) ram2 ram1")
     apply (case_tac "between (vertices oldF) ram1 ram2")
      apply simp apply (subgoal_tac "|vertices oldF| = 2")
       apply simp apply (frule verticesFrom_ram1)
      apply (subgoal_tac "distinct (vertices oldF)") apply (drule verticesFrom_length)
        apply (subgoal_tac "ram1  𝒱 oldF") apply assumption apply (simp add: pre_split_face_def) apply simp
       apply (simp add: pre_split_face_def)
      apply (rule normFace_neq)
        apply (subgoal_tac "a  𝒱 (Face (rev vs @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal)")
         apply assumption apply simp apply force  apply simp
    apply (rule not_sym)
    apply (rule normFace_neq)
      apply (subgoal_tac "a  𝒱 (Face (ram2 # between (vertices oldF) ram2 ram1 @ ram1 # vs) Nonfinal)")
       apply assumption apply simp
     apply (frule verticesFrom_ram1)
     apply (subgoal_tac "distinct (verticesFrom oldF ram1)") apply clarsimp
     apply (rule verticesFrom_distinct)
      by (simp add: pre_split_face_def)+
qed


lemma normFace_in: "f  set fs  normFace f  set (normFaces fs)"
by (simp add: normFaces_def)



subsection‹Invariants of @{const splitFace}
(********************************** splitFace & minGraphProps *************************************)

lemma splitFace_holds_minGraphProps':
  "pre_splitFace g' v a f' vs  minGraphProps' g' 
  minGraphProps' (snd (snd (splitFace g' v a f' vs)))"
apply (simp add: minGraphProps'_def)
apply safe
 apply (simp add: splitFace_def split_def)
 apply (case_tac "f   g'") apply simp
 apply safe
  apply (simp add: split_face_def) apply safe apply simp apply (drule pre_FaceDiv_between1) apply simp
 apply (frule_tac replace1)
  apply simp_all
 apply (simp add: split_face_def) apply safe apply simp
 apply (drule pre_FaceDiv_between2) apply simp
apply (drule splitFace_split)
apply safe
  apply simp
 apply (subgoal_tac "pre_splitFace g' v a f' vs")
  apply (drule splitFace_distinct2)+ apply simp+
apply (subgoal_tac "pre_splitFace g' v a f' vs")
 apply (drule splitFace_distinct1)+
 by simp+


lemma splitFace_holds_faceListAt_len:
  "pre_splitFace g' v a f' vs  minGraphProps g' 
   faceListAt_len (snd (snd (splitFace g' v a f' vs)))"
by (simp add: minGraphProps_def faceListAt_len_def splitFace_def split_def)


lemma splitFace_new_f12:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
    and props: "minGraphProps g"
    and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "f12   g"
proof (cases newVs)
  case Nil with pre have "(ram2, ram1)  edges g"
    by (unfold pre_splitFace_def) auto
  moreover from Nil pre
  have "(ram2, ram1)  edges f12"
    apply (rule_tac splitFace_empty_ram2_ram1_in_f12)
     apply (auto simp: Nil[symmetric])
    apply (rule spl)
    done
  ultimately show ?thesis by (auto simp add: edges_graph_def)
next
  case (Cons v vs)
  with pre have "v  𝒱 g"
    by (auto simp: pre_splitFace_def)
  moreover from Cons spl have "v  𝒱 f12"
    by (simp add: splitFace_f12_new_vertices)
  moreover note props
  ultimately show ?thesis by (auto dest: minGraphProps)
qed

lemma splitFace_new_f12_norm:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "normFace f12  set (normFaces (faces g))"
proof (cases newVs)
  case Nil with pre have "(ram2, ram1)  edges g"
    by (auto simp: pre_splitFace_def)
  moreover
  from pre spl [symmetric] have dist_f12: "distinct (vertices f12)"
    apply (drule_tac splitFace_distinct2) by simp                  
  moreover
  from Nil pre
  have "(ram2, ram1)  edges f12"
    apply (rule_tac splitFace_empty_ram2_ram1_in_f12)
     apply (auto simp: Nil[symmetric])
    apply (rule spl)
    done
  moreover
  with dist_f12 have "vertices f12  []"
    apply (simp add: is_nextElem_def) apply (case_tac "vertices f12") apply (simp add: is_sublist_def)
    by simp
  ultimately show ?thesis
    apply (auto simp add: edges_graph_def) apply (frule normFace_in_cong)
      apply (rule props)
     apply assumption
    apply (elim bexE)
    apply (subgoal_tac "(ram2, ram1)  edges f'") apply simp
    apply (subgoal_tac "(vertices f12)  (vertices f')")  apply (frule congs_distinct)
     apply (simp add: cong_face_def is_nextElem_congs_eq)+
    done
next
  case (Cons v vs)
  with pre have "v  𝒱 g" by (auto simp: pre_splitFace_def)
  moreover from Cons spl have "v  𝒱 f12"
    by (simp add: splitFace_f12_new_vertices)
  moreover note props
  ultimately show ?thesis
    apply auto
    apply (subgoal_tac "(vertices f12)  []")
     apply (frule normFace_in_cong) apply assumption+ apply (erule bexE)
     apply (subgoal_tac "v  𝒱 f'") apply (simp add: minGraphProps9)
     apply (simp add: congs_pres_nodes cong_face_def) by auto
qed

lemma splitFace_new_f21:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "f21   g"
proof (cases newVs)
  case Nil with pre have "(ram1, ram2)  edges g"
    by (auto simp: pre_splitFace_def)
  moreover from Nil pre
  have "(ram1, ram2)  edges f21"
    apply (rule_tac splitFace_empty_ram1_ram2_in_f21)
     apply (auto simp: Nil[symmetric])
    apply (rule spl)
    done
  ultimately show ?thesis by (auto simp add: edges_graph_def)
next
  case (Cons v vs)
  with pre have "v  𝒱 g" by (auto simp: pre_splitFace_def)
  moreover from Cons spl have "v  𝒱 f21"
    by (simp add: splitFace_f21_new_vertices)
  moreover note props
  ultimately show ?thesis by (auto dest: minGraphProps)
qed

lemma splitFace_new_f21_norm:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "normFace f21  set (normFaces (faces g))"
proof (cases newVs)
  case Nil with pre have "(ram1, ram2)  edges g"
    by (auto simp: pre_splitFace_def)
  moreover
  from pre spl [symmetric] have dist_f21: "distinct (vertices f21)"
    apply (drule_tac splitFace_distinct1) by simp
  moreover
  from Nil pre
  have "(ram1, ram2)  edges f21"
    apply (rule_tac splitFace_empty_ram1_ram2_in_f21)
     apply (auto simp: Nil[symmetric])
    apply (rule spl)
    done
  moreover
  with dist_f21 have "vertices f21  []"
    apply (simp add: is_nextElem_def) apply (case_tac "vertices f21") apply (simp add: is_sublist_def)
    by simp
  ultimately show ?thesis apply (auto simp add: edges_graph_def) apply (frule normFace_in_cong)
      apply (rule props)
     apply assumption
    apply (elim bexE)
    apply (subgoal_tac "(ram1, ram2)  edges f'") apply simp
    apply (subgoal_tac "(vertices f21)  (vertices f')")  apply (frule congs_distinct)
     apply (simp add: cong_face_def is_nextElem_congs_eq)+
    done
next
  case (Cons v vs)
  with pre have "v  𝒱 g" by (auto simp: pre_splitFace_def)
  moreover from Cons spl have "v  𝒱 f21"
    by (simp add: splitFace_f21_new_vertices)
  moreover note props
  ultimately show ?thesis apply auto
    apply (subgoal_tac "(vertices f21)  []")
     apply (frule normFace_in_cong) apply assumption+ apply (erule bexE)
     apply (subgoal_tac "v  𝒱 f'") apply (simp add: minGraphProps9)
     apply (simp add: congs_pres_nodes cong_face_def) by auto
qed

lemma splitFace_f21_oldF_neq:
 "pre_splitFace g ram1 ram2 oldF newVs 
  minGraphProps g 
 (f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs 
  oldF  f21"
by (frule splitFace_new_f21) (auto)

lemma splitFace_f12_oldF_neq:
 "pre_splitFace g ram1 ram2 oldF newVs 
  minGraphProps g 
 (f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs 
  oldF  f12"
by (frule splitFace_new_f12) (auto)


lemma splitFace_f12_f21_neq_norm:
 "pre_splitFace g ram1 ram2 oldF vs  minGraphProps g 
 (f12, f21, newGraph) = splitFace g ram1 ram2 oldF vs 
  normFace f12  normFace f21"
apply (subgoal_tac "minGraphProps' newGraph")
 apply (subgoal_tac "f12   newGraph  f21   newGraph")
  apply (subgoal_tac "pre_split_face oldF ram1 ram2 vs")
   apply (frule split_face_f12_f21_neq_norm) apply (rule minGraphProps2) apply simp apply(erule pre_splitFace_oldF)
      apply (subgoal_tac "2 < | vertices f12 |") apply assumption apply (force simp: minGraphProps'_def)
     apply (subgoal_tac "2 < | vertices f21 |") apply assumption apply (force simp: minGraphProps'_def)
    apply (simp add: splitFace_def split_def)
   apply simp
  apply force
 apply (simp add: splitFace_def split_def)
 apply (rule disjI2)
 apply (erule replace3[OF pre_splitFace_oldF])
 apply simp
apply (frule splitFace_holds_minGraphProps') apply (simp add: minGraphProps_def minGraphProps'_def)
by (simp add: splitFace_def split_def)


lemma set_faces_splitFace:
" minGraphProps g; f   g; pre_splitFace g v1 v2 f vs;
  (f1, f2, g') = splitFace g v1 v2 f vs 
    g' = {f1,f2}  ( g - {f})"
apply(frule minGraphProps11')
apply(blast dest:splitFace_new_f21 splitFace_new_f12
                 splitFace_faces_1 splitFace_delete_oldF)
done


declare minGraphProps8 minGraphProps8a minGraphProps8a' [intro]

lemma splitFace_holds_facesAt_distinct:
assumes pre: "pre_splitFace g v w f [countVertices g..<countVertices g + n]"
    and mgp: "minGraphProps g"
shows "facesAt_distinct (snd (snd (splitFace g v w f [countVertices g..<countVertices g + n])))"
proof -
  define ws where "ws = [countVertices g..<countVertices g + n]"
  define f21 where "f21 = snd (split_face f v w ws)"
  with pre ws_def have dist_f21: "distinct (vertices f21)" by (auto intro: split_face_distinct2)
  define f12 where "f12 = fst (split_face f v w ws)"
  with pre ws_def have dist_f12: "distinct (vertices f12)" by (auto intro: split_face_distinct1)
  define vs1 where "vs1 = between (vertices f) v w"
  define vs2 where "vs2 = between (vertices f) w v"
  define g' where "g' = snd (snd (splitFace g v w f [countVertices g..<countVertices g + n]))"
  from f12_def f21_def ws_def g'_def
  have fdg: "(f12, f21, g') = splitFace g v w f [countVertices g..<countVertices g + n]"
    by (simp add: splitFace_def split_def)
  from pre mgp fdg have new_f12: "f12   g"
    apply (rule_tac splitFace_new_f12)  by simp_all
  from pre mgp fdg have new_f21: "f21   g"
    apply (rule_tac splitFace_new_f21) by simp_all
  from pre mgp fdg have new_f12_norm: "normFace f12  set (normFaces (faces g))"
    apply (rule_tac splitFace_new_f12_norm)  by simp_all
  from pre mgp fdg have new_f21_norm: "normFace f21  set (normFaces (faces g))"
    apply (rule_tac splitFace_new_f21_norm) by simp_all


  have "facesAt_distinct g'"
  proof (rule facesAt_distinctI)
    fix x assume x: "x  𝒱 g'"
    show "distinct (normFaces (facesAt g' x))"
      proof -
      from mgp pre have a: "v < |faceListAt g|" "w < |faceListAt g|"
        apply (unfold pre_splitFace_def)
        apply (simp_all add: minGraphProps4)
        by (auto intro: minGraphProps9')
      then show ?thesis
      proof (cases "x = w")
        case True
        moreover with pre have "v  w"
          by (unfold pre_splitFace_def) simp
        moreover note a x pre mgp
        ultimately show ?thesis
          apply -
          apply (unfold pre_splitFace_def)
          apply (unfold g'_def splitFace_def facesAt_def)
          apply (simp add: split_def nth_append)
          apply (rule distinct_replace_norm)
            apply (rule distinct_replacefacesAt_norm)
                apply simp
               apply (rule between_distinct)
               apply simp
              apply (rule distinct_replacefacesAt_norm)
                  apply assumption
                 apply (rule between_distinct)
                 apply simp
                apply (rule minGraphProps8a') apply assumption+  apply (simp add: minGraphProps4)
               apply (simp add: normFaces_def)

              apply (subgoal_tac "set (faceListAt g ! w) = {f   g. w  𝒱 f}") apply simp
               apply (subgoal_tac "set (normFaces (faces g))  {normFace f12} = {}")
                apply (simp add: f12_def ws_def normFaces_def) apply blast
               apply (simp add: new_f12_norm)

              apply (frule minGraphProps_facesAt_eq)
               apply (subgoal_tac "w  𝒱 g") apply assumption
               apply (rule minGraphProps9) apply assumption apply blast apply simp
              apply (simp add: facesAt_def split: if_split_asm)

             apply (simp add: normFaces_def)

            apply (subgoal_tac "w  set (between (vertices f) v w)")
             apply (simp add: replacefacesAt_notin)
             apply (subgoal_tac "set (faceListAt g ! w) = {f   g. w  𝒱 f}")
              apply (subgoal_tac "set (normFaces (faces g))  {normFace f21} = {}")
               apply (simp add: f21_def ws_def normFaces_def) apply blast
              apply (simp add: new_f21_norm)

             apply (frule minGraphProps_facesAt_eq)
              apply (subgoal_tac "w  𝒱 g") apply assumption
              apply (rule minGraphProps9) apply assumption apply blast apply simp
             apply (simp add: facesAt_def minGraphProps4 vertices_graph)
            apply (rule between_not_r2) apply simp
        
           apply (simp add: normFaces_def) apply (rule splitFace_f12_f21_neq_norm)
             apply (rule pre) apply simp
           apply (subgoal_tac "(f12, f21, g') = splitFace g v w f [countVertices g..<countVertices g + n]")
            apply (simp add: f12_def f21_def g'_def ws_def)
           apply (rule fdg)

          apply (subgoal_tac "w  set (between (vertices f) w v)")
           apply (simp add: replacefacesAt_notin)
           apply (subgoal_tac "w  set (between (vertices f) v w)")
            apply (simp add: replacefacesAt_notin)
            apply (subgoal_tac "set (faceListAt g ! w) = {f   g. w  𝒱 f}")
             apply (subgoal_tac "set (normFaces (faces g))  {normFace f12,normFace f21} = {}")
              apply (simp add: f12_def f21_def ws_def normFaces_def) apply blast
             apply (simp add: new_f21_norm new_f12_norm)
            apply (frule minGraphProps_facesAt_eq)
             apply (subgoal_tac "w  𝒱 g") apply assumption
             apply (rule minGraphProps9) apply assumption apply blast apply simp
            apply (simp add: facesAt_def minGraphProps4 vertices_graph)
           apply (rule between_not_r2) apply simp
          apply (rule between_not_r1) by simp
      next
        from pre have vw_neq: "v  w"
          by (unfold pre_splitFace_def) simp
        case False then show ?thesis
          proof (cases "x = v")
            case True
              with a x pre mgp vw_neq
              show ?thesis
                apply -
                apply (unfold pre_splitFace_def)
                apply (unfold g'_def splitFace_def facesAt_def)
                apply (simp add: split_def nth_append)
                apply (rule distinct_replace_norm)
                  apply (rule distinct_replacefacesAt_norm)
                      apply simp
                     apply (rule between_distinct)
                     apply simp
                    apply (rule distinct_replacefacesAt_norm)
                        apply assumption
                       apply (rule between_distinct)
                       apply simp
                      apply (rule minGraphProps8a) apply assumption+ apply (simp add: minGraphProps4 vertices_graph)

                     apply (simp add:normFaces_def)

                    apply (subgoal_tac "set (faceListAt g ! v) = {f   g. v  𝒱 f}")
                     apply (subgoal_tac "set (normFaces (faces g))  {normFace f12} = {}")
                      apply (simp add: f12_def ws_def normFaces_def) apply blast
                     apply (simp add: new_f12_norm)

                    apply (frule minGraphProps_facesAt_eq)
                     apply (subgoal_tac "v  𝒱 g") apply assumption
                     apply (rule minGraphProps9) apply assumption apply blast apply simp
                    apply (simp add: facesAt_def split: if_split_asm)

                   apply (simp add: normFaces_def)

                  apply (subgoal_tac "v  set (between (vertices f) v w)")
                   apply (simp add: replacefacesAt_notin)
                   apply (subgoal_tac "set (faceListAt g ! v) = {f   g. v  𝒱 f}")
                    apply (subgoal_tac "set (normFaces (faces g))  {normFace f21} = {}")
                     apply (simp add: f21_def ws_def normFaces_def) apply blast
                    apply (simp add: new_f21_norm)

                   apply (frule minGraphProps_facesAt_eq)
                    apply (subgoal_tac "v  𝒱 g") apply assumption
                    apply (rule minGraphProps9) apply assumption apply blast apply simp
                   apply (simp add: facesAt_def split: if_split_asm)
                  apply (rule between_not_r1) apply simp
                 apply (simp add: normFaces_def) apply (rule not_sym)
                 apply (rule splitFace_f12_f21_neq_norm) apply (rule pre) apply simp
                 apply (subgoal_tac "(f12, f21, g') = splitFace g v w f [countVertices g..<countVertices g + n]")
                  apply (simp add: f12_def f21_def ws_def g'_def)  apply (rule fdg)

                apply (subgoal_tac "v  set (between (vertices f) w v)")
                 apply (simp add: replacefacesAt_notin)
                 apply (subgoal_tac "v  set (between (vertices f) v w)")
                  apply (simp add: replacefacesAt_notin)
                  apply (subgoal_tac "set (faceListAt g ! v) = {f   g. v  𝒱 f}")
                   apply (subgoal_tac "set (normFaces (faces g))  {normFace f21,normFace f12} = {}")
                    apply (simp add: f12_def f21_def ws_def normFaces_def) apply blast
                   apply (simp add: new_f21_norm new_f12_norm)
                  apply (subgoal_tac "set (normFaces (faces g))  {normFace f21} = {}")
                   apply (simp add: new_f21_norm)
                   apply (frule minGraphProps_facesAt_eq)
                    apply (subgoal_tac "v  𝒱 g") apply assumption
                    apply (rule minGraphProps9) apply assumption apply blast apply simp
                   apply (simp add: facesAt_def minGraphProps4 vertices_graph)
                  apply (simp add: new_f21_norm)
                 apply (rule between_not_r1) apply simp
                apply (rule between_not_r2) by simp
              next
                assume xw_neq: "x  w"
                case False
                with a x pre mgp vw_neq xw_neq
                show ?thesis
                  apply -
                  apply (unfold pre_splitFace_def g'_def splitFace_def facesAt_def)
                  apply (simp add: split_def nth_append)
                  apply (case_tac "x < |faceListAt g|")
                   apply simp
                   apply (subgoal_tac "x  𝒱 g")
                    apply (rule distinct_replacefacesAt_norm)
                        apply simp
                       apply (rule between_distinct)
                       apply simp
                      apply (rule distinct_replacefacesAt_norm) apply assumption
                         apply (rule between_distinct)
                         apply simp
                        apply (rule minGraphProps8a) apply assumption apply (simp add: minGraphProps4)

                       apply (simp add: normFaces_def)

                      apply (subgoal_tac "set (faceListAt g ! x) = {f   g. x  𝒱 f}")
                       apply (subgoal_tac "set (normFaces (faces g))  {normFace f12} = {}")
                        apply (simp add: f12_def ws_def normFaces_def) apply blast
                       apply (simp add: new_f12_norm)

                      apply (frule minGraphProps_facesAt_eq) apply assumption
                      apply (simp add: facesAt_def split: if_split_asm)
                     apply (simp add: normFaces_def)

                    apply (case_tac "x  set (between (vertices f) v w)")
                     apply (simp add: replacefacesAt_notin)
                     apply (subgoal_tac "set (faceListAt g ! x) = {f   g. x  𝒱 f}")
                      apply (subgoal_tac "set (normFaces (faces g))  {normFace f21} = {}")
                       apply (simp add: f21_def ws_def normFaces_def) apply blast
                      apply (simp add: new_f21_norm)

                     apply (frule minGraphProps_facesAt_eq) apply assumption
                     apply (simp add: facesAt_def split: if_split_asm)
                    apply (simp add: normFaces_def)
                    apply (drule replacefacesAt_nth) apply assumption
                        apply (subgoal_tac "f  set [fst (split_face f v w [countVertices g..<countVertices g + n])]")
                         apply assumption apply simp
                        apply (rule splitFace_f12_oldF_neq)
                          apply (subgoal_tac "pre_splitFace g v w f [countVertices g..<countVertices g + n]")
                           apply assumption apply (simp add: pre) apply assumption+
                        apply (simp add: splitFace_def split_def)
                       apply (rule normFaces_distinct)
                       apply (rule minGraphProps8a) apply assumption apply (simp add: minGraphProps4 vertices_graph)
                      apply (simp add: normFaces_def)
                     apply (rule impI) apply simp
                     apply (subgoal_tac "set (faceListAt g ! x) = {f   g. x  𝒱 f}")
                      apply (subgoal_tac " g  {f12} = {}")
                       apply (simp add: f12_def ws_def)
                      apply (simp add: new_f12)
                     apply (frule minGraphProps_facesAt_eq)
                      apply (subgoal_tac "x  𝒱 g") apply assumption
                      apply (simp add: minGraphProps4 vertices_graph)
                     apply (simp add:facesAt_def minGraphProps4 vertices_graph)
                    apply (frule replacefacesAt_nth) apply assumption

                        apply (subgoal_tac "f  set [fst (split_face f v w [countVertices g..<countVertices g + n])]")
                         apply assumption apply simp apply (rule splitFace_f12_oldF_neq)
                          apply (subgoal_tac "pre_splitFace g v w f [countVertices g..<countVertices g + n]") apply assumption
                          apply (simp add: pre) apply assumption apply (simp add: splitFace_def split_def)
                       apply (rule normFaces_distinct)
                       apply (rule minGraphProps8a') apply assumption apply (simp add: minGraphProps4)
                      apply simp
                     apply (rule impI) apply simp
                     apply (subgoal_tac "set (faceListAt g ! x) = {f   g. x  𝒱 f}")
                      apply (subgoal_tac " g  {f12} = {}")
                       apply (simp add: f12_def ws_def)
                      apply (simp add: new_f12)
                     apply (frule minGraphProps_facesAt_eq)
                      apply (subgoal_tac "x  𝒱 g") apply assumption
                      apply (simp add: minGraphProps4 vertices_graph)
                     apply (simp add:facesAt_def minGraphProps4 vertices_graph)
                    apply (simp add: f12_def [symmetric] f21_def [symmetric] ws_def [symmetric])
                    apply (subgoal_tac "normFace f21  set (normFaces (replace f [f12] (faceListAt g ! x)))")
                     apply (simp add: normFaces_def)
                    apply (rule ccontr) apply simp
                    apply (frule normFace_replace_in)
                    apply (subgoal_tac "normFace f12  normFace f21")
                     apply (subgoal_tac "normFace f21  set (normFaces (faceListAt g ! x))")
                      apply (simp add: normFaces_def)
                     apply (rule ccontr) apply simp
                     apply (subgoal_tac "normFace f21  set (normFaces (facesAt g x))")
                      apply (simp add: facesAt_def)(*
                      apply (subgoal_tac "x ∈ 𝒱 g") apply (simp add: normFaces_def)
                      apply (simp add: minGraphProps4 vertices_graph)*)
                     apply (subgoal_tac "normFace f21  set (normFaces (faces g))") apply (frule minGraphProps_facesAt_eq)
                       apply (subgoal_tac "x  𝒱 g") apply assumption apply (simp add: minGraphProps4 vertices_graph)
                      apply (simp add: normFaces_def) apply (rule ccontr)  apply simp
                      apply blast
                     apply (rule new_f21_norm)
                    apply (rule splitFace_f12_f21_neq_norm) apply (rule pre) apply simp apply (rule fdg)
                   apply (simp add: minGraphProps4 vertices_graph)

(* zweite große Implikation *)
                  apply (simp add: normFaces_def)
                  apply (subgoal_tac "(x - |faceListAt g | ) < n") apply simp
                   apply (rule splitFace_f12_f21_neq_norm) apply (rule pre) apply simp
                   apply (simp add: f12_def [symmetric] f21_def [symmetric]  ws_def [symmetric]) apply (simp add: ws_def) apply (rule fdg)
                by (simp add: minGraphProps4)
              qed
            qed
          qed
        qed
  then show ?thesis by (simp add: g'_def)
qed


lemma splitFace_holds_facesAt_eq:
assumes pre_F: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and mgp: "minGraphProps g'"
and g'': "g'' = (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
shows "facesAt_eq g''"
proof -
  have "[0..<countVertices g''] = [0..<countVertices g' + n]"
    apply (simp add: g'') by (simp add: splitFace_def split_def)
  hence vg'': "vertices g'' = [0..<countVertices g' + n]" by (simp add:vertices_graph)

  define ws where "ws = [countVertices g'..<countVertices g' + n]"
  define f21 where "f21 = snd (split_face f' v a ws)"
  define f12 where "f12 = fst (split_face f' v a ws)"
  define vs1 where "vs1 = between (vertices f') v a"
  define vs2 where "vs2 = between (vertices f') a v"
  from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric] g'' have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
    by (simp add: splitFace_def split_def)
  from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def ws_def) by force

  from pre_F' mgp fdg have f'_f21: "f'  f21" apply (rule_tac splitFace_f21_oldF_neq) apply assumption by simp+
  from pre_F' mgp fdg have f'_f12: "f'  f12" apply (rule_tac splitFace_f12_oldF_neq) apply assumption by simp+

  from f12_def vs1_def have vert_f12: "vertices f12 = rev ws @ v # vs1 @ [a]" by (simp add: split_face_def)
  from f21_def vs2_def have vert_f21: "vertices f21 = a # vs2 @ v # ws" by (simp add: split_face_def)
  from vs1_def vs2_def pre_F have vertFrom_f': "verticesFrom f' v =
    v # vs1 @ a # vs2" apply simp
    apply (rule_tac verticesFrom_ram1) by (rule pre_splitFace_pre_split_face)
  from vs1_def vs2_def pre_F vertFrom_f' have vert_f': "𝒱 f' =  set vs1  set vs2  {a,v}"
    apply (subgoal_tac "(vertices f')  (verticesFrom f' v)") apply (drule congs_pres_nodes)
    apply (simp add: congs_pres_nodes) apply blast
    apply (rule verticesFrom_congs) by (simp only: pre_splitFace_def)
  from pre_F have dist_vertFrom_f': "distinct (verticesFrom f' v)" apply (rule_tac verticesFrom_distinct)
    by (simp only: pre_splitFace_def)+
  then have vs1_vs2_empty: "set vs1  set vs2 = {}" by (simp add: vertFrom_f')

  from ws_def f21_def f12_def have "faces g'' = (replace f' [f21]  (faces g')) @ [f12]"
    apply (simp add: g'') by (simp add: splitFace_def split_def)

  from mgp have dist_all: "x. x  𝒱 g'  distinct (faceListAt g' ! x)"
    apply (rule_tac normFaces_distinct)
    by (simp add: minGraphProps_def facesAt_distinct_def facesAt_def)

  from mgp have fla: "|faceListAt g'| = countVertices g'"
    by (simp add: minGraphProps_def faceListAt_len_def)

  from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric]
    vs1_def [symmetric] vs2_def [symmetric] pre_F mgp vert_f'
show ?thesis
apply (simp add: g'')
apply (unfold splitFace_def facesAt_eq_def facesAt_def)
apply (rule ballI)
apply (simp only: split_def Let_def)
apply (simp only: snd_conv)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp only: faceListAt.simps vertices_graph.simps split:if_split_asm)
 apply (case_tac "v < |faceListAt g'|  a < | faceListAt g'|")
  apply (simp only: nth_append split: if_split_asm)
   apply (case_tac "va < | faceListAt g' |")
    apply (subgoal_tac "va  𝒱 g'")
     apply (subgoal_tac "distinct vs1  distinct vs2 
       v  set vs1  v  set vs2  a  set vs1  a  set vs2  a  v  v  a  set vs1  set vs2 = {}" )
      apply (case_tac "a = va")
       apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
       apply (subgoal_tac "distinct (faceListAt g' ! va)")
        apply (subgoal_tac "distinct (faces g')")
         apply (simp add: replace6)
         apply (case_tac "x = f12") apply (simp add: vert_f12) apply simp
         apply (case_tac "x = f'") apply (simp add: vert_f21) apply(simp)
         apply (case_tac "x = f21") apply (simp add: vert_f21) apply (simp)
         apply (rule conjI)
          apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
         apply (rule minGraphProps6) apply assumption apply assumption apply (simp add: facesAt_def)
        apply (rule minGraphProps11') apply simp
       apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
       apply (rule normFaces_distinct) apply (rule minGraphProps8) apply simp apply simp apply simp
      apply (case_tac "v = va")
       apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
       apply (subgoal_tac "distinct (faceListAt g' ! va)")
        apply (subgoal_tac "distinct (faces g')")
         apply (simp add: replace6)
         apply (case_tac "x = f12") apply (simp add: vert_f12) apply simp
         apply (case_tac "x = f'") apply (simp add: vert_f21) apply simp
         apply (case_tac "x = f21") apply (simp add: vert_f21) apply simp
         apply (rule conjI)
          apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
         apply (rule minGraphProps6) apply assumption apply assumption apply(fastforce simp: facesAt_def)
        apply (rule minGraphProps11') apply simp
       apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
       apply (rule normFaces_distinct) apply (rule minGraphProps8) apply simp apply simp apply simp
      apply (case_tac "va  set vs1")
       apply (subgoal_tac "va  set vs2")
        apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
        apply (subgoal_tac "distinct (faceListAt g' ! va)")
         apply (subgoal_tac "distinct (faces g')")
          apply (simp add: replace6)
          apply (case_tac "x = f12") apply (simp add: vert_f12) apply simp
          apply (case_tac "x = f'") apply (simp add: vert_f21) apply simp
          apply (rule conjI)
           apply (rule disjI2)
           apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
          apply (rule minGraphProps6) apply assumption apply assumption apply (fastforce simp: facesAt_def)
         apply (rule minGraphProps11') apply simp
        apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
        apply (rule normFaces_distinct) apply (rule minGraphProps8) apply assumption apply assumption
       apply blast
      apply (case_tac "va  set vs2")
       apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
       apply (subgoal_tac "distinct (faceListAt g' ! va)")
        apply (subgoal_tac "distinct (faces g')")
         apply (simp add: replace6)
         apply (case_tac "x = f21") apply (simp add: vert_f21) apply simp
         apply (case_tac "x = f'") apply (simp add: vert_f21) apply simp
         apply (rule conjI)
          apply (rule disjI2)
          apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
         apply (rule minGraphProps6) apply assumption apply assumption apply (fastforce simp: facesAt_def)
        apply (rule minGraphProps11') apply simp
       apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
       apply (rule normFaces_distinct) apply (rule minGraphProps8) apply assumption apply assumption
    (* case else *)
      apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
      apply (subgoal_tac "distinct (faceListAt g' ! va)")
       apply (subgoal_tac "distinct (faces g')")
        apply (simp add: replace6)
        apply (case_tac "x = f'")
         apply (subgoal_tac "va  𝒱 f'") apply simp
         apply (rule minGraphProps6) apply simp apply (simp add: fla)
         apply (simp add: facesAt_def)
        apply simp
        apply (rule conjI)
         apply (rule disjI2) apply (rule disjI2)
         apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
        apply (rule minGraphProps6) apply assumption apply assumption apply(fastforce simp: facesAt_def)
       apply (rule minGraphProps11') apply assumption
      apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
      apply (rule normFaces_distinct) apply (rule minGraphProps8) apply assumption apply assumption apply simp
     apply (subgoal_tac "distinct (vertices f12)  distinct (vertices f21)")
      apply (simp add: vert_f12 vert_f21)
      apply (rule vs1_vs2_empty)
     apply (subgoal_tac "pre_split_face f' v a ws")
      apply (simp add: f12_def f21_def split_face_distinct1' split_face_distinct2')
     apply simp
    apply (simp add: vertices_graph fla)
    (* va in ws *)
   apply simp
  apply (subgoal_tac "distinct (faces g')")
   apply (simp add: replace6)
   apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
   apply (subgoal_tac "(va - |faceListAt g'| ) < | ws |") apply simp apply (rule conjI) apply blast
    apply (subgoal_tac "va  set ws")
     apply (case_tac "x = f12") apply (simp add: vert_f12) apply (simp add: vert_f21)
    apply (simp add: ws_def fla)
   apply (simp add: ws_def fla)
  apply (rule minGraphProps11') apply assumption
 apply (subgoal_tac "v  𝒱 g'  a  𝒱 g'")
  apply (simp only: fla in_vertices_graph)
 apply (subgoal_tac "f'   g'")
  apply (subgoal_tac "v  𝒱 f'  a  𝒱 f'") apply (simp only: minGraphProps9) apply force
  apply (subgoal_tac "pre_split_face f' v a ws") apply (simp only: pre_split_face_def) apply force
  apply (rule pre_splitFace_pre_split_face) apply assumption
 apply (simp only: pre_splitFace_def)

(* Rückrichtung *)
apply (rule subsetI)
apply (case_tac "v < |faceListAt g'|  a < | faceListAt g'|")
 apply (case_tac "va < | faceListAt g' |")
  apply (subgoal_tac "va  𝒱 g'")
   apply (subgoal_tac "distinct vs1  distinct vs2 
       v  set vs1  v  set vs2  a  set vs1  a  set vs2  a  v  v  a  set vs1  set vs2 = {}" )
    apply (simp del: replacefacesAt_simps add: nth_append)
    apply (case_tac "a = va")
     apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
     apply (subgoal_tac "distinct (faceListAt g' ! va)")
      apply (subgoal_tac "distinct (faces g')")
       apply (simp add: replace6)
       apply (case_tac "x = f12") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp  apply simp apply simp
       apply (case_tac "x = f21") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp  apply simp apply simp
       apply simp apply (rule minGraphProps7') apply simp apply simp apply  simp
      apply (rule minGraphProps11') apply simp
     apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply assumption
    apply simp
    apply (case_tac "v = va")
     apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
     apply (subgoal_tac "distinct (faceListAt g' ! va)")
      apply (subgoal_tac "distinct (faces g')")
       apply (simp add: replace6)
       apply (case_tac "x = f12") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp  apply simp apply simp
       apply (case_tac "x = f21") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp  apply simp apply simp
       apply simp apply (rule minGraphProps7') apply simp apply simp apply  simp
      apply (rule minGraphProps11') apply simp apply (rule normFaces_distinct)      apply (rule minGraphProps8a) apply simp apply simp     apply (case_tac "va  set vs1")
     apply (subgoal_tac "va  set vs2")
      apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
      apply (subgoal_tac "distinct (faceListAt g' ! va)")
       apply (subgoal_tac "distinct (faces g')")
        apply (simp add: replace6)
        apply (case_tac "x = f12") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp  apply simp apply simp
        apply (case_tac "x = f'")
         apply (subgoal_tac "f'  f21") apply simp apply (rule splitFace_f21_oldF_neq)
           apply (rule pre_F')
          apply simp
         apply (rule fdg)
        apply (case_tac "x = f21") apply (simp add: vert_f21 fla) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
         apply (simp add: ws_def)
        apply simp apply (rule minGraphProps7') apply simp  apply simp apply simp
       apply (rule minGraphProps11') apply simp
      apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
     apply blast
    apply (case_tac "va  set vs2")
     apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
     apply (subgoal_tac "distinct (faceListAt g' ! va)")
      apply (subgoal_tac "distinct (faces g')")
       apply (simp add: replace6)
       apply (case_tac "x = f21") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp  apply simp apply simp
       apply (case_tac "x = f'")
        apply (subgoal_tac "f'  f12") apply simp apply (rule splitFace_f12_oldF_neq)
          apply (rule pre_F') apply simp  apply (rule fdg)
       apply (case_tac "x = f12") apply (simp add: vert_f12 fla) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
        apply (simp add: ws_def)
       apply simp apply (rule minGraphProps7') apply simp  apply simp apply simp
      apply (rule minGraphProps11') apply simp apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
    apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
    apply (subgoal_tac "distinct (faces g')")
     apply (simp add: replace6)
     apply (rule minGraphProps7') apply simp
      apply (case_tac "x = f21") apply (simp add: vert_f21) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
       apply (simp add: ws_def vertices_graph)
      apply (case_tac "x = f12") apply (simp add: vert_f12) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
       apply (simp add: ws_def vertices_graph)
      apply simp
     apply simp
    apply (rule minGraphProps11') apply simp
   apply (subgoal_tac "distinct (vertices f12)  distinct (vertices f21)")
    apply (simp add: vert_f12 vert_f21)
    apply (rule vs1_vs2_empty)
   apply (subgoal_tac "pre_split_face f' v a ws")
    apply (simp add: f12_def f21_def split_face_distinct1' split_face_distinct2')
   apply (simp add: pre_splitFace_pre_split_face[OF pre_F'])
  apply (simp add: vertices_graph fla)
 apply (simp add: nth_append del:replacefacesAt_simps)
 apply (subgoal_tac "distinct (faces g')")
  apply (simp add: replace6)
  apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
  apply (subgoal_tac "(va - |faceListAt g'| ) < |ws|") apply simp
   apply (rule ccontr) apply simp
   apply (case_tac "x = f'") apply simp apply simp
   apply (subgoal_tac "va  𝒱 g'") apply (simp add: fla vertices_graph)
   apply (rule minGraphProps9) apply simp apply force
   apply (simp add: fla) apply (metis minGraphProps9')
  apply (simp add: ws_def fla)
 apply (rule minGraphProps11') apply simp
apply (subgoal_tac "v  𝒱 g'  a  𝒱 g'")
 apply (simp only: fla in_vertices_graph)
apply (subgoal_tac "f'   g'")
 apply (subgoal_tac "v  𝒱 f'  a  𝒱 f'") apply (simp only: minGraphProps9) apply force
by force
qed

lemma splitFace_holds_faces_subset:
assumes pre_F: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and mgp: "minGraphProps g'"
shows "faces_subset (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
proof -
  define g'' where "g'' = (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
  define ws where "ws = [countVertices g'..<countVertices g' + n]"
  define f21 where "f21 = snd (split_face f' v a ws)"
  define f12 where "f12 = fst (split_face f' v a ws)"
  define vs1 where "vs1 = between (vertices f') v a"
  define vs2 where "vs2 = between (vertices f') a v"
  from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric] g''_def
    have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
      by (simp add: splitFace_def split_def)
  from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def ws_def) by force

  from f12_def vs1_def have vert_f12: "vertices f12 = rev ws @ v # vs1 @ [a]" by (simp add: split_face_def)
  from f21_def vs2_def have vert_f21: "vertices f21 = a # vs2 @ v # ws" by (simp add: split_face_def)
  from vs1_def vs2_def pre_F have vertFrom_f': "verticesFrom f' v =
    v # vs1 @ a # vs2" apply simp
    apply (rule_tac verticesFrom_ram1) by (rule pre_splitFace_pre_split_face)
  from vs1_def vs2_def pre_F vertFrom_f' have vert_f': "𝒱 f' =  set vs1  set vs2  {a,v}"
    apply (subgoal_tac "(vertices f')  (verticesFrom f' v)") apply (drule congs_pres_nodes)
    apply (simp add: congs_pres_nodes) apply blast
    apply (rule verticesFrom_congs) by (simp only: pre_splitFace_def)

  from ws_def f21_def f12_def have faces:"faces g'' = (replace f' [f21]  (faces g')) @ [f12]"
    apply (simp add: g''_def) by (simp add: splitFace_def split_def)

  from ws_def have vertices:"vertices g'' = vertices g' @ ws" by (simp add: g''_def)

  from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric]
    vs1_def [symmetric] vs2_def [symmetric] pre_F mgp  g''_def [symmetric] show ?thesis
    apply (simp add: faces_subset_def) apply (rule ballI)  apply (simp add: faces vertices)
    apply (subgoal_tac "𝒱 f'  𝒱 g'")
    apply (case_tac "f = f12") apply (simp add: vert_f12 vert_f') apply force
    apply simp apply (drule replace5)
    apply (case_tac "f = f21") apply (simp add: vert_f21 vert_f') apply force
    apply simp apply (rule subsetI) apply (frule minGraphProps9) apply assumption+ apply simp
    apply (rule subsetI) apply (rule minGraphProps9) by auto
qed


lemma splitFace_holds_edges_sym:
assumes pre_F: "pre_splitFace g' v a f' ws"
and mgp: "minGraphProps g'"
shows "edges_sym (snd (snd (splitFace g' v a f' ws)))"
proof -
  define g'' where "g'' = (snd (snd (splitFace g' v a f' ws)))"
  define f21 where "f21 = snd (split_face f' v a ws)"
  define f12 where "f12 = fst (split_face f' v a ws)"
  define vs1 where "vs1 = between (vertices f') v a"
  define vs2 where "vs2 = between (vertices f') a v"
  from f21_def [symmetric] f12_def [symmetric] g''_def
    have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
      by (simp add: splitFace_def split_def)
  from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def) by force

  from f21_def f12_def have faces:"faces g'' = (replace f' [f21]  (faces g')) @ [f12]"
    apply (simp add: g''_def) by (simp add: splitFace_def split_def)

  from f12_def f21_def have split: "(f12, f21) = split_face f' v a ws" by simp

  from pre_F mgp  g''_def [symmetric] split show ?thesis
    apply (simp add: edges_sym_def edges_graph_def f21_def [symmetric] f12_def [symmetric]
    vs1_def [symmetric] vs2_def [symmetric])
    apply (intro allI impI) apply (elim bexE) apply (simp add: faces)
    apply (case_tac "x = f12  x = f21")
     apply (subgoal_tac "(aa,b)  edges f'   ((b,aa)  (edges f12  edges f21)  (aa,b)  (edges f12  edges f21))") apply simp
      apply (case_tac "(aa, b)  edges f'")
       apply (subgoal_tac "(b,aa)  edges g'")
        apply (simp add: edges_graph_def) apply (elim bexE) apply (rule disjI2) apply (rule bexI)
         apply simp
        apply (subgoal_tac "xa  f'") apply (rule replace4) apply simp apply force
        apply (drule minGraphProps12) apply simp apply simp
        apply (rule ccontr) apply simp
       apply (rule minGraphProps10) apply simp apply (simp add: edges_graph_def)
       apply (rule bexI)  apply (thin_tac "(aa, b)  edges x") apply simp
       apply simp
      apply simp
      apply (case_tac "(b, aa)  edges f12") apply simp apply simp
      apply (case_tac "(b, aa)  edges f21") apply (rule bexI)
        apply simp
       apply (rule replace3) apply simp
       apply simp
      apply simp
     apply (subgoal_tac "
     ((aa,b)  edges f'   ((b,aa)  (edges f12  edges f21)  (aa,b)  (edges f12  edges f21))) = ((aa,b)  edges f12  (aa,b)  edges f21)") apply force
     apply (rule sym) apply simp
     apply (rule split_face_edges_f12_f21_sym) apply (erule pre_splitFace_oldF)
      apply (subgoal_tac "pre_split_face f' v a ws") apply assumption  apply simp
     apply (rule split)
    apply simp
    apply (subgoal_tac "distinct (faces g')") apply (simp add: replace6)
     apply (case_tac "x = f'") apply simp apply simp
     apply (subgoal_tac "(b,aa)  edges g'")
      apply (simp add: edges_graph_def) apply (elim bexE)
      apply (case_tac "xa = f'")
       apply simp apply (frule split_face_edges_or) apply simp apply simp
       apply (case_tac "(b, aa)  edges f12") apply simp apply simp
       apply (rule bexI) apply (thin_tac "(b, aa)  edges f'")
        apply simp
       apply (rule replace3) apply simp apply simp
      apply (rule disjI2) apply (rule bexI) apply simp
      apply (rule replace4) apply simp
      apply force
     apply (rule minGraphProps10) apply simp
     apply (simp add: edges_graph_def)
     apply (rule bexI)  apply simp apply simp
    apply (rule minGraphProps11') by simp
qed


lemma splitFace_holds_faces_distinct:
assumes pre_F: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and mgp: "minGraphProps g'"
shows "faces_distinct (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
proof -
  define g'' where "g'' = snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n]))"
  define ws where "ws  [countVertices g'..<countVertices g' + n]"
  define f21 where "f21 = snd (split_face f' v a ws)"
  define f12 where "f12 = fst (split_face f' v a ws)"
  define vs1 where "vs1 = between (vertices f') v a"
  define vs2 where "vs2 = between (vertices f') a v"
  from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric] g''_def
  have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
    by (simp add: splitFace_def split_def)
  from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def ws_def) by force

  from ws_def f21_def f12_def have faces:"faces g'' = (replace f' [f21]  (faces g')) @ [f12]"
    apply (simp add: g''_def) by (simp add: splitFace_def split_def)
  from f12_def f21_def have split: "(f12, f21) = split_face f' v a ws" by simp

  from ws_def [symmetric] pre_F mgp  g''_def [symmetric] split show ?thesis
    apply (simp add: faces_distinct_def faces)
    apply (subgoal_tac "distinct (normFaces (replace f' [f21] (faces g')))")
     apply (simp add: normFaces_def)
     apply safe
     apply (subgoal_tac "distinct (faces g')") apply (simp add: replace6)
      apply (case_tac "x = f'") apply simp
       apply (subgoal_tac "f'  f21") apply simp
       apply (rule splitFace_f21_oldF_neq)
         apply (rule pre_F') apply simp
       apply (rule fdg)
      apply simp
      apply (case_tac "x = f21") apply simp
       apply (subgoal_tac "normFace f12  normFace f21") apply simp
       apply (rule splitFace_f12_f21_neq_norm) apply force apply simp
       apply (simp add: fdg) apply (rule fdg)
      apply simp
      apply (subgoal_tac "normFace f12  set (normFaces (faces g'))")
       apply (simp add: normFaces_def)
      apply (rule splitFace_new_f12_norm) apply (rule pre_F')  apply simp
      apply (rule fdg)
     apply (rule minGraphProps11') apply simp
    apply (rule distinct_replace_norm) apply (rule minGraphProps11) apply simp
     apply (simp add: normFaces_def)
    apply (subgoal_tac "normFace f21  set (normFaces (faces g'))")
     apply (simp add: normFaces_def)
    apply (rule splitFace_new_f21_norm) apply (rule pre_F')  apply simp
    by (rule fdg)
qed


lemma "help":
shows "xs  []  x  set xs   x  hd xs" and
      "xs  []  x  set xs   x  last xs" and
      "xs  []  x  set xs   hd xs  x" and
      "xs  []  x  set xs   last xs  x"
by(auto)

lemma split_face_edge_disj:
 " pre_split_face f a b vs; (f1, f2) = split_face f a b vs; |vertices f|  3;
    vs = []  (a,b)  edges f  (b,a)  edges f 
      f1   f2 = {}"
apply(frule pre_split_face_p_between[THEN between_inter_empty])
apply(unfold pre_split_face_def)
apply clarify
apply(subgoal_tac "x y. x  set vs  y  𝒱 f  x  y")
 prefer 2 apply blast
apply(subgoal_tac "x y. x  set vs  y  𝒱 f  y  x")
 prefer 2 apply blast
apply(subgoal_tac "a  set vs")
 prefer 2 apply blast
apply(subgoal_tac "b  set vs")
 prefer 2 apply blast
apply(subgoal_tac "distinct(vs @ a # between (vertices f) a b @ [b])")
 prefer 2 apply(simp add:between_not_r1 between_not_r2 between_distinct)
 apply(blast dest:inbetween_inset)
apply(subgoal_tac "distinct(b # between (vertices f) b a @ a # rev vs)")
 prefer 2 apply(simp add:between_not_r1 between_not_r2 between_distinct)
 apply(blast dest:inbetween_inset)
apply(subgoal_tac "vs = []  between (vertices f) a b  []")
 prefer 2 apply clarsimp apply(frule (4) is_nextElem_between_empty')apply blast
apply(subgoal_tac "vs = []  between (vertices f) b a  []")
 prefer 2 apply clarsimp
apply(frule (3) is_nextElem_between_empty')apply simp apply blast
apply(subgoal_tac "vs  []  hd vs  𝒱 f")
 prefer 2 apply(drule hd_in_set) apply blast
apply(subgoal_tac "vs  []  last vs  𝒱 f")
 prefer 2 apply(drule last_in_set) apply blast
apply(subgoal_tac "u v. between (vertices f) u v  []  hd(between (vertices f) u v)  𝒱 f")
 prefer 2 apply(drule hd_in_set)apply(drule inbetween_inset) apply blast
apply(subgoal_tac "u v. between (vertices f) u v  []  last (between (vertices f) u v)  𝒱 f")
 prefer 2 apply(drule last_in_set) apply(drule inbetween_inset) apply blast
apply(simp add:split_face_def edges_conv_Edges Edges_append Edges_Cons
 last_rev notinset_notinEdge1 notinset_notinEdge2 notinset_notinbetween
 between_not_r1 between_not_r2 "help" Edges_rev_disj disj_sets_disj_Edges
 Int_Un_distrib Int_Un_distrib2)
apply clarify
apply(rule conjI)
 apply clarify
 apply(rule disj_sets_disj_Edges)
 apply simp
 apply(blast dest:inbetween_inset)
apply clarify
apply(rule conjI)
 apply clarify
 apply(rule disj_sets_disj_Edges)
 apply simp
 apply(blast dest:inbetween_inset)
apply clarify
apply(rule conjI)
 apply(rule disj_sets_disj_Edges)
 apply simp
 apply(blast dest:inbetween_inset)
apply(rule disj_sets_disj_Edges)
apply(blast dest:inbetween_inset)
done


lemma splitFace_edge_disj:
assumes mgp: "minGraphProps g" and pre: "pre_splitFace g u v f vs"
and FDG: "(f1,f2,g') = splitFace g u v f vs"
shows "edges_disj g'"
proof -
  from mgp have disj: "edges_disj g" by(simp add:minGraphProps_def)
  have "𝒱 g  set vs = {}" using pre
    by (simp add: pre_splitFace_def)
  hence gvs: "f   g. 𝒱 f  set vs = {}"
    by (clarsimp simp:edges_graph_def edges_face_def)
       (blast dest: minGraphProps9[OF mgp])
  have f: "f   g" by (rule pre_splitFace_oldF[OF pre])
  note split_face = splitFace_split_face[OF f FDG]
  note pre_split_face = pre_splitFace_pre_split_face[OF pre]
  have " f1   f2 = {}"
    apply(rule split_face_edge_disj[OF pre_split_face split_face mgp_vertices3[OF mgp f]])
    using pre
    apply(simp add:pre_splitFace_def del: pre_splitFace_oldF)
    apply clarify
    by(simp) (* loops if combined *)
  moreover
  { fix f' assume f': "f'   g" "f'  f"
    have "( f1   f2)   f' = {}"
    proof cases
      assume vs: "vs = []"
      have "(u,v)   g  (v,u)   g" using pre vs
        by(simp add:pre_splitFace_def)
      with split_face_edges_f12_f21_vs[OF pre_split_face[simplified vs] split_face[simplified vs]]
      show ?thesis using f f' disj
        by(simp add:is_duplicateEdge_def edges_graph_def edges_disj_def)
    next
      assume vs: "vs  []"
      have f12: "vs  []   f1   f2 
             f  UNIV × set vs  set vs × UNIV"
        using split_face_edges_f12_f21[OF pre_split_face split_face]
        by simp (fastforce dest:in_Edges_in_set)
      have "x y. (y,x)   f'  x  set vs  y  set vs"
        using f' gvs by(blast dest:in_edges_in_vertices)
      then show ?thesis using f f' f12 disj vs
        by(simp add: edges_graph_def edges_disj_def) blast
    qed }
  ultimately show ?thesis using disj
    by(simp add:edges_disj_def set_faces_splitFace[OF mgp f pre FDG])
      blast
qed

lemma splitFace_edges_disj2:
 "minGraphProps g  pre_splitFace g u v f vs
  edges_disj(snd(snd(splitFace g u v f vs)))"
apply(subgoal_tac "pre_splitFace g u v f vs")
 prefer 2 apply(simp)
by(drule (1) splitFace_edge_disj[where f1 = "fst(splitFace g u v f vs)" and f2 = "fst(snd(splitFace g u v f vs))"], auto)


lemma vertices_conv_Union_edges2:
 "distinct(vertices f)  𝒱(f::face) = ((a,b) f. {b})"
apply auto
apply(fast intro: prevVertex_in_edges)
done

lemma splitFace_face_face_op:
assumes mgp: "minGraphProps g" and pre: "pre_splitFace g u v f vs"
and fdg: "(f1,f2,g') = splitFace g u v f vs"
shows "face_face_op g'"
proof -
  have f12: "(f1, f2) = split_face f u v vs"
   and Fg': " g' = {f1}  set(replace f [f2] (faces g))"
   and g': "g' = snd (snd (splitFace g u v f vs))" using fdg
    by(auto simp add:splitFace_def split_def)
  have f1: "f1= fst(split_face f u v vs)" and f2: "f2 = snd(split_face f u v vs)"
    using f12[symmetric] by simp_all
  note distF = minGraphProps11'[OF mgp]
  note pre_split = pre_splitFace_pre_split_face[OF pre]
  note distf1 = split_face_distinct1[OF f12 pre_split]
  note distf2 = split_face_distinct2[OF f12 pre_split]
  from pre have nf: "¬ final f" and fg: "f   g" and nuv: "u  v"
    and uinf: "u  𝒱 f"and vinf: "v  𝒱 f"
    and distf: "distinct(vertices f)" and new: "𝒱 g  set vs = {}"
    by(unfold pre_splitFace_def, simp)+
  let ?fuv = "between (vertices f) u v" and ?fvu = "between (vertices f) v u"
  have E1: " f1 = Edges (v # rev vs @ [u])  Edges (u # ?fuv @ [v])"
    using f1 by(simp add:edges_split_face1[OF pre_split])
  have E2: " f2 = Edges (u # vs @ [v])  Edges (v # ?fvu @ [u])"
    using f2 by(simp add:edges_split_face2[OF pre_split])
  have vf1: "vertices f1 = rev vs @ u # ?fuv @ [v]"
    using f1 by(simp add:split_face_def)
  have vf2: "vertices f2 = [v] @ ?fvu @ u # vs"
    using f2 by(simp add:split_face_def)
  have V1: "𝒱 f1 = {u,v}  set(?fuv)  set(vs)" using vf1 by auto
  have V2: "𝒱 f2 = {u,v}  set(?fvu)  set(vs)" using vf2 by auto
  have 2: "(v,u)   f1  (u,v)   f2  vs = [] 
           (v  𝒱 f1  𝒱 f2. v  𝒱 g)"
    using E1 E2 V1 V2 new by(cases vs)(simp_all add:Edges_Cons)
  have "𝒱 f1  𝒱 f2"
  proof cases
    assume A: "?fvu = []"
    have "?fuv  []"
    proof
      assume "?fuv = []"
      with A have " f = {(v,u),(u,v)}"
        using edges_conv_Un_Edges[OF distf uinf vinf nuv]
        by(simp add:Edges_Cons)
      hence "𝒱 f = {u,v}" by(simp add:vertices_conv_Union_edges)
      hence "card(𝒱 f)  2" by(simp add:card_insert_if)
      thus False
        using mgp_vertices3[OF mgp fg] by(simp add:distinct_card[OF distf])
    qed
    moreover have "set ?fuv  set vs = {}"
      using new minGraphProps9[OF mgp fg inbetween_inset] by blast
    moreover have "{u,v}  set ?fuv = {}"
      using between_not_r1[OF distf] between_not_r2[OF distf] by blast
    ultimately show ?thesis using V1 V2 A by (auto simp:neq_Nil_conv)
  next
    assume "?fvu  []"
    moreover have "{u,v}  set ?fvu = {}"
      using between_not_r1[OF distf] between_not_r2[OF distf] by blast
    moreover have "set ?fuv  set ?fvu = {}"
      by(simp add:pre_between_def between_inter_empty distf uinf vinf nuv)
    moreover have "set ?fvu  set vs = {}"
      using new minGraphProps9[OF mgp fg inbetween_inset] by blast
    ultimately show ?thesis using V1 V2 by (auto simp:neq_Nil_conv)
  qed
  have C12: " f1  ( f2)¯"
  proof
    assume A: " f1 = ( f2)¯"
    show False
    proof -
      have "𝒱 f1 = ((a,b) f1. {a})"
        by(rule vertices_conv_Union_edges)
      also have " = ((b,a) f2. {a})" by(auto simp:A)
      also have " = 𝒱 f2"
        by(rule vertices_conv_Union_edges2[OF distf2, symmetric])
      finally show False using 𝒱 f1  𝒱 f2 by blast
    qed
  qed
  { fix h :: face assume hg: "h   g"
    have " h  ( f1)¯   h  ( f2)¯" using 2
    proof
      assume "(v,u)   f1  (u,v)   f2  vs = []"
      moreover hence "(u,v)   g"
        using pre by(unfold pre_splitFace_def)simp
      moreover hence "(v,u)   g" by(blast intro:minGraphProps10[OF mgp])
      ultimately show ?thesis using hg by(simp add:edges_graph_def) blast
    next
      assume "x  𝒱 f1  𝒱 f2. x  𝒱 g"
      then obtain x where "x  𝒱 f1" and "x  𝒱 f2" and "x  𝒱 g"
        by blast
      obtain y where "(x,y)   f1" using x  𝒱 f1
        by(auto simp:vertices_conv_Union_edges)
      moreover obtain z where "(x,z)   f2" using x  𝒱 f2
        by(auto simp:vertices_conv_Union_edges)
      moreover have "¬(y. (y,x)   h)"
        using x  𝒱 g minGraphProps9[OF mgp hg]
        by(blast dest:in_edges_in_vertices)
      ultimately show ?thesis by blast
    qed
  }
  note Cg12 = this
  show ?thesis
  proof cases
    assume 2: "|faces g| = 2"
    with fg obtain f' where Fg: " g = {f,f'}"
      by(fastforce simp: eval_nat_numeral length_Suc_conv)
    moreover hence "f  f'" using 2 distinct_card[OF distF] by auto
    ultimately have Fg': " g' = {f1,f2,f'}"
      using set_faces_splitFace[OF mgp fg pre fdg] by blast
    show ?thesis using Fg' C12 Cg12 Fg
      by(fastforce simp:face_face_op_def)
  next
    assume "|faces g|  2"
    hence E: "f f'. f g  f' g  f  f'   f  ( f')¯"
      using mgp by(simp add:minGraphProps_def face_face_op_def)
    thus ?thesis using set_faces_splitFace[OF mgp fg pre fdg] C12 Cg12
      by(fastforce simp:face_face_op_def)
  qed
qed

lemma splitFace_face_face_op2:
 "minGraphProps g  pre_splitFace g u v f vs
  face_face_op(snd(snd(splitFace g u v f vs)))"
apply(subgoal_tac "pre_splitFace g u v f vs")
 prefer 2 apply(simp)
by(drule (1) splitFace_face_face_op[where f1 = "fst(splitFace g u v f vs)" and f2 = "fst(snd(splitFace g u v f vs))"], auto)

lemma splitFace_holds_minGraphProps:
  assumes precond: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
  and min: "minGraphProps g'"
  shows "minGraphProps (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
proof -
  from min have "minGraphProps' g'" by (simp add: minGraphProps_def)
  then show ?thesis apply (simp add: minGraphProps_def) apply safe
    apply (rule splitFace_holds_minGraphProps') apply (rule precond) apply assumption
    apply (rule splitFace_holds_facesAt_eq) apply (rule precond) apply (rule min) apply simp
    apply (rule splitFace_holds_faceListAt_len) apply (rule precond) apply (rule min)
    apply (rule splitFace_holds_facesAt_distinct) apply (rule precond) apply (rule min)
    apply (rule splitFace_holds_faces_distinct) apply (rule precond) apply (rule min)
    apply (rule splitFace_holds_faces_subset) apply (rule precond) apply (rule min)
    apply (rule splitFace_holds_edges_sym) apply (rule precond) apply (rule min)
    apply (rule splitFace_edges_disj2) apply (rule min) apply (rule precond)
    apply (rule splitFace_face_face_op2) apply (rule min) apply (rule precond)
    done
qed


subsection‹Invariants of @{const makeFaceFinal}


lemma MakeFaceFinal_minGraphProps':
  "f   g  minGraphProps g  minGraphProps' (makeFaceFinal f g)"
apply (simp add: minGraphProps_def minGraphProps'_def makeFaceFinal_def)
apply (subgoal_tac "2 < |vertices f|  distinct (vertices f)")
 apply (rule ballI) apply (elim conjE ballE) apply (rule conjI) apply simp apply simp
  apply (simp add: makeFaceFinalFaceList_def) apply (drule replace5) apply (simp add: setFinal_def)
by force

lemma MakeFaceFinal_facesAt_eq:
  "f   g  minGraphProps g  facesAt_eq (makeFaceFinal f g)"
apply (simp add: facesAt_eq_def) apply (rule ballI)
apply (subgoal_tac "v  𝒱 g")
 apply (rule equalityI)
  apply (rule subsetI)
  apply (simp add: makeFaceFinal_def facesAt_def)
  apply (subgoal_tac "v < | faceListAt g | ")
   apply (simp add: makeFaceFinalFaceList_def)
   apply (subgoal_tac "distinct ((faceListAt g ! v))")
    apply (subgoal_tac "distinct (faces g)")
     apply (simp add: replace6)
     apply (case_tac "x = f")
      apply simp apply (erule (1) minGraphProps6) apply (simp add: facesAt_def) apply blast
     apply simp
     apply (case_tac " f  set (faceListAt g ! v)  x = setFinal f") apply simp
      apply (subgoal_tac "v  𝒱 f") apply (simp add: setFinal_def)
      apply (erule (1) minGraphProps6) apply (simp add: facesAt_def)
     apply simp
     apply (rule conjI) apply (rule disjI2)
      apply (erule (1) minGraphProps5) apply (fastforce simp: facesAt_def)
     apply (erule (1) minGraphProps6) apply (fastforce simp: facesAt_def)
    apply (rule minGraphProps11') apply simp
   apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
  apply (simp add: vertices_graph minGraphProps4)
    (* backward *)

 apply (rule subsetI) apply (simp add: makeFaceFinal_def facesAt_def)
 apply (subgoal_tac "v < | faceListAt g | ") apply simp
  apply (subgoal_tac "distinct (faceListAt g ! v)")
   apply (subgoal_tac "distinct (faces g)")
    apply (simp add: makeFaceFinalFaceList_def replace6)
    apply (case_tac "x = setFinal f") apply simp
     apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp
    apply (simp add: setFinal_def) apply simp
   apply (rule minGraphProps7') apply simp apply simp apply simp
   apply (rule minGraphProps11') apply simp
  apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
 apply (simp add: vertices_graph minGraphProps4)
   (* Vorbed v in set (vertices g) *)
apply (simp add: makeFaceFinal_def) by (simp add: in_vertices_graph minGraphProps4)

lemma MakeFaceFinal_faceListAt_len:
 "f   g  minGraphProps g  faceListAt_len (makeFaceFinal f g)"
  apply (simp add: faceListAt_len_def makeFaceFinal_def) apply (rule minGraphProps4) by simp

lemma normFaces_makeFaceFinalFaceList: "(normFaces (makeFaceFinalFaceList f fs)) = (normFaces fs)"
  apply (simp add: normFaces_def) apply (simp add: makeFaceFinalFaceList_def)
  apply (induct fs) apply simp apply simp apply (rule impI)
  by (simp add: setFinal_def normFace_def verticesFrom_def minVertex_def)

lemma MakeFaceFinal_facesAt_distinct:
 "f   g   minGraphProps g  facesAt_distinct (makeFaceFinal f g)"
  apply (simp add: facesAt_distinct_def makeFaceFinal_def)
  apply (clarsimp simp: facesAt_def)
  apply (subgoal_tac "v < | (faceListAt g) |") apply (simp add: normFaces_makeFaceFinalFaceList)
  apply (rule minGraphProps8a') apply simp apply simp by (simp add: minGraphProps4)

lemma MakeFaceFinal_faces_subset:
 "f   g   minGraphProps g  faces_subset (makeFaceFinal f g)"
  apply (simp add: faces_subset_def) apply (intro ballI subsetI)
  apply (simp add: makeFaceFinal_def makeFaceFinalFaceList_def)
  apply (drule replace5)
  apply (case_tac "fa   g") apply simp apply (rule minGraphProps9')
    apply simp apply (thin_tac "f   g") apply simp+
  apply (rule minGraphProps9') apply simp apply simp by (simp add: setFinal_def)

lemma MakeFaceFinal_edges_sym:
 "f   g   minGraphProps g  edges_sym (makeFaceFinal f g)"
  apply (simp add: edges_sym_def) apply (intro allI impI)
  apply (simp add: makeFaceFinal_def edges_graph_def)
  apply (elim bexE) apply (simp add: makeFaceFinalFaceList_def)
  apply (subgoal_tac "distinct (faces g)")
  apply (case_tac "x   g")
    apply (subgoal_tac "(a,b)  edges g") apply (frule minGraphProps10) apply assumption
    apply (simp add: edges_graph_def) apply (elim bexE)
    apply (case_tac "xb = f")
      apply (subgoal_tac "(b,a)  edges (setFinal f)")
        apply (rule bexI) apply (rotate_tac -1)  apply assumption
        apply (rule replace3) apply simp apply simp
      apply (subgoal_tac "distinct (vertices f)")
      apply (simp add: edges_setFinal)
      apply (rule minGraphProps3) apply simp apply simp
    apply (rule bexI) apply assumption apply (rule replace4) apply simp apply force
    apply (simp add: edges_graph_def) apply force
  apply (frule replace5) apply simp
  apply (subgoal_tac "(a,b)  edges g")
  apply (frule minGraphProps10) apply assumption apply (simp add: edges_graph_def) apply (elim bexE)
    apply (case_tac "xb = f")
      apply (subgoal_tac "(b, a)  edges (setFinal f)")
        apply (rule bexI) apply (rotate_tac -1) apply assumption
        apply (rule replace3) apply simp apply simp
      apply (subgoal_tac "distinct (vertices f)")
      apply (simp add: edges_setFinal)
      apply (rule minGraphProps3) apply simp apply simp
    apply  (rule bexI) apply simp apply (rule replace4) apply simp apply force
  apply (subgoal_tac "distinct (vertices f)")
  apply (subgoal_tac "(a,b)  edges f")
  apply (simp add: edges_graph_def)   apply force
  apply (simp add: edges_setFinal)
  apply (rule minGraphProps3) apply simp apply simp
  by (rule minGraphProps11')

lemma MakeFaceFinal_faces_distinct:
 "f   g   minGraphProps g  faces_distinct (makeFaceFinal f g)"
  apply (simp add: faces_distinct_def makeFaceFinal_def normFaces_makeFaceFinalFaceList)
  by (rule minGraphProps11)

lemma MakeFaceFinal_edges_disj:
 "f   g   minGraphProps g  edges_disj (makeFaceFinal f g)"
apply(frule minGraphProps11')
apply (clarsimp simp: edges_disj_def makeFaceFinal_def edges_graph_def
                      makeFaceFinalFaceList_def replace6)
apply(case_tac "f = f'")
 apply (fastforce dest:mgp_edges_disj)
apply (fastforce dest:mgp_edges_disj)
done


lemma MakeFaceFinal_face_face_op:
 "f   g  minGraphProps g  face_face_op (makeFaceFinal f g)"
apply(subgoal_tac "face_face_op g")
 prefer 2 apply(simp add:minGraphProps_def)
apply(drule minGraphProps11')
apply(auto simp: face_face_op_def makeFaceFinal_def makeFaceFinalFaceList_def
                 distinct_set_replace)
done


lemma MakeFaceFinal_minGraphProps:
 "f   g  minGraphProps g  minGraphProps (makeFaceFinal f g)"
apply (simp (no_asm) add: minGraphProps_def)
apply (simp add: MakeFaceFinal_minGraphProps' MakeFaceFinal_facesAt_eq
    MakeFaceFinal_faceListAt_len MakeFaceFinal_facesAt_distinct
    MakeFaceFinal_faces_subset MakeFaceFinal_edges_sym
    MakeFaceFinal_edges_disj MakeFaceFinal_faces_distinct
    MakeFaceFinal_face_face_op)
done


subsection‹Invariants of @{const subdivFace'}

lemma subdivFace'_holds_minGraphProps: " f v' v n g.
  pre_subdivFace' g f v' v n ovl  f   g 
  minGraphProps g  minGraphProps (subdivFace' g f v n ovl)"
proof (induct ovl)
  case Nil then show ?case by (simp add: MakeFaceFinal_minGraphProps)
next
  case (Cons ov ovl) then show ?case
apply auto
apply (cases "ov")
 apply (simp_all split: if_split_asm)
 apply (rule Cons)
   apply (rule pre_subdivFace'_None)
   apply simp_all
apply (intro conjI)
 apply clarsimp
 apply (rule Cons)
   apply (rule pre_subdivFace'_Some2)
   apply simp_all
apply (clarsimp simp: split_def)
apply (rule Cons)
  apply (rule pre_subdivFace'_Some1)
       apply simp_all
  apply (simp add: minGraphProps_def faces_subset_def)
 apply (rule splitFace_add_f21')
 apply simp_all
apply (rule splitFace_holds_minGraphProps)
 apply simp_all
apply (rule pre_subdivFace'_preFaceDiv)
   apply simp_all
by (simp add: minGraphProps_def faces_subset_def)
qed


(* Invariance of one_final *)

abbreviation (input)
  Edges_if :: "face  vertex  vertex  (vertex × vertex)set" where
  "Edges_if f u v ==
    if u=v then {} else Edges(u # between (vertices f) u v @ [v])"

lemma FaceDivsionGraph_one_final_but:
assumes mgp: "minGraphProps g" and pre: "pre_splitFace g u v f vs"
and fdg: "(f1,f2,g') = splitFace g u v f vs"
and nrv: "r  v"
and ruv: "before (verticesFrom f r) u v" and rf: "r  𝒱 f"
and 1: "one_final_but g (Edges_if f r u)"
shows "one_final_but g' (Edges(r # between (vertices f2) r v @ [v]))"
proof -
  have f1: "f1= fst(split_face f u v vs)" and f2: "f2 = snd(split_face f u v vs)"
   and F: " g' = {f1}  set(replace f [f2] (faces g))"
   and g': "g' = snd (snd (splitFace g u v f vs))" using fdg
    by(auto simp add:splitFace_def split_def)
  note pre_split = pre_splitFace_pre_split_face[OF pre]
  from pre have nf: "¬ final f" and fg: "f   g" and nuv: "u  v"
    and uinf: "u  𝒱 f"and vinf: "v  𝒱 f"
    by(unfold pre_splitFace_def, simp)+
  from mgp fg have distf: "distinct(vertices f)" by(rule minGraphProps3)
  note distFg = minGraphProps11'[OF mgp]
  have fvu: "ru  between (vertices f) v u =
                     between (vertices f) v r @ r # between (vertices f) r u"
    using before_between2[OF ruv distf rf] nrv
      split_between[OF distf vinf uinf, of r] by (auto)
  let ?fuv = "between (vertices f) u v" and ?fvu = "between (vertices f) v u"
  let ?fru = "between (vertices f) r u" and ?f2rv = "between (vertices f2) r v"
  have E1: " f1 = Edges (v # rev vs @ [u])  Edges (u # ?fuv @ [v])"
    using f1 by(simp add:edges_split_face1[OF pre_split])
  have E2: " f2 = Edges (u # vs @ [v])  Edges (v # ?fvu @ [u])"
    using f2 by(simp add:edges_split_face2[OF pre_split])
  have vf2: "vertices f2 = [v] @ ?fvu @ u # vs"
    using f2 by(simp add:split_face_def)
  have vinf2: "v  𝒱 f2" using vf2 by(simp)
  have rinf2: "r  𝒱 f2"
  proof cases
    assume "r=u" thus ?thesis by(simp add:vf2)
  next
    assume "ru" thus ?thesis by(simp add: vf2 fvu)
  qed
  have distf2: "distinct(vertices f2)"
    by(simp add:f2)(rule split_face_distinct2'[OF pre_split])
  have f2uv: "between (vertices f2) u v = vs"
    using vf2 distf2 by(simp add:between_def split_def)
  have f2ru: "ru  between (vertices f2) r u = between (vertices f) r u"
    using vf2 fvu distf distf2 by(simp add:between_def split_def)
  hence f2rv: "between (vertices f2) r v =
              (if r=u then [] else ?fru @ [u]) @ vs"
  proof cases
    assume "r=u" thus ?thesis by(simp add: f2uv)
  next
    assume nru: "r  u"
    have vinf2: "v  𝒱 f2" by(simp add: vf2)
    note u_bet_rv = before_between[OF ruv distf rf nru]
    have u_bet_rv2: "u  set (between (vertices f2) r v)"
      using distf2 nru
      apply(simp add:vf2 fvu)
      apply(subst between_def[of _ r v])
      apply(simp add:split_def)
      done
    show ?thesis
      by(simp add:split_between[OF distf2 rinf2 vinf2 u_bet_rv2] f2ru f2uv)
  qed
  have E2rv: "Edges(r # ?f2rv @ [v]) =
         Edges_if f r u  Edges(u # vs @ [v])" (is "?L = ?R")
  proof -
    have "?L = Edges((if r=u then [] else r # ?fru) @ (u # vs @ [v]))"
      by (simp add: f2rv)
    also have " = ?R" by(auto simp:Edges_Cons Edges_append)
    finally show ?thesis .
  qed
  show ?thesis
  proof (auto del: disjCI simp:one_final_but_def F, goal_cases)
    case prems: (1 a b)
    have ab: "(a,b)   f1"
      and nab: "(a,b)  Edges (r # ?f2rv @ [v])" by fact+
    have "(a,b)  Edges (v # rev vs @ [u]) 
          (a,b)  Edges (u # ?fuv @ [v])" (is "?A  ?B")
      using E1 ab by blast
    thus ?case
    proof
      assume ?A
      hence "(b,a)  Edges (rev(v # rev vs @ [u]))" by (simp del:rev.simps)
      hence "(b,a)  Edges (r # ?f2rv @ [v])" using E2rv by simp
      thus ?case by blast
    next
      assume abfuv: ?B
      have abf: "(a,b)   f"
        by(rule Edges_between_edges[OF abfuv pre_split])
      have "(f'set(replace f [f2] (faces g)). final f'  (b,a)   f')"
      proof cases
        assume "r = u"
        then obtain f' where "f'   g  final f'  (b, a)   f'"
          using abf 1 nf fg by(simp add:one_final_but_def)fast
        moreover then have "f'  set (replace f [f2] (faces g))"
          by(clarsimp simp: replace6[OF distFg] nf)
        ultimately show ?thesis by blast
      next
        assume nru: "r  u"
        moreover hence "(a,b)  Edges (r # ?fru @ [u])"
          using abfuv Edges_disj[OF distf rf vinf nru nuv
                        before_between[OF ruv distf rf nru]] by fast
        moreover have "(b,a)  Edges (r # ?fru @ [u])"
        proof
          assume "(b,a)  Edges (r # ?fru @ [u])"
          moreover have "pre_split_face f r u []"
            by(simp add:pre_split_face_def distf rf uinf nru)
          ultimately show False
            using minGraphProps12[OF mgp fg abf]
            by(blast dest:Edges_between_edges)
        qed
        ultimately obtain f' where "f'   g  final f'  (b, a)   f'"
          using abf 1 nf fg by(simp add:one_final_but_def)fast
        moreover hence "f'  set (replace f [f2] (faces g))"
          by(clarsimp simp: replace6[OF distFg] nf)
        ultimately show ?thesis by blast
      qed
      thus ?case ..
    qed
  next
    case (2 f' a b)
    have f': "f'  set (replace f [f2] (faces g))"
      and nf': "¬ final f'" and abf': "(a,b)   f'"
      and nab: "(a,b)  Edges (r # between (vertices f2) r v @ [v])" by fact+
    have "f' = f2  f'   g  f'  f"
      using f' by(simp add:replace6[OF distFg]) blast
    hence "(b, a)  Edges (r # between (vertices f2) r v @ [v]) 
      (f'set (replace f [f2] (faces g)). final f'  (b, a)   f')"
      (is "?A  ?B")
    proof
      assume [simp]: "f' = f2"
      have "(a,b)  Edges (v # between (vertices f2) v r @ [r])"
        using abf' nab Edges_compl[OF distf2 vinf2 rinf2 nrv[symmetric]]
        edges_conv_Un_Edges[OF distf2 rinf2 vinf2 nrv] by auto
      moreover have eq: "between(vertices f2) v r = between (vertices f) v r"
      proof (cases "r=u")
        assume "r=u" thus ?thesis
          by(simp add:vf2)(rule between_front[OF between_not_r2[OF distf]])
      next
        assume "ru" thus ?thesis
          by(simp add:vf2 fvu)(rule between_front[OF between_not_r2[OF distf]])
      qed
      ultimately
      have abfvr: "(a,b)  Edges (v # between (vertices f) v r @ [r])"
        by simp
      have abf: "(a,b)   f"
        apply(rule Edges_between_edges[where vs = "[]", OF abfvr])
        using distf rf vinf nrv by(simp add:pre_split_face_def)
      have "(f'set(replace f [f2] (faces g)). final f'  (b,a)   f')"
      proof cases
        assume "r = u"
        then obtain f' where "f'   g  final f'  (b, a)   f'"
          using abf 1 nf fg by(simp add:one_final_but_def)fast
        moreover then have "f'  set (replace f [f2] (faces g))"
          by(clarsimp simp: replace6[OF distFg] nf)
        ultimately show ?thesis by blast
      next
        assume nru: "r  u"
        note uvr = rotate_before_vFrom[OF distf rf nru ruv]
        note bet = before_between[OF uvr distf vinf  nrv[symmetric]]
        have "(a,b)  Edges (r # ?fru @ [u])"
          using abfvr Edges_disj[OF distf vinf uinf nrv[symmetric] nru bet]
          by fast
        moreover have "(b,a)  Edges (r # ?fru @ [u])"
        proof
          assume "(b,a)  Edges (r # ?fru @ [u])"
          moreover have "pre_split_face f r u []"
            by(simp add:pre_split_face_def distf rf uinf nru)
          ultimately show False
            using minGraphProps12[OF mgp fg abf]
            by(blast dest:Edges_between_edges)
        qed
        ultimately obtain f' where "f'   g  final f'  (b, a)   f'"
          using abf 1 nf fg nru by(simp add:one_final_but_def)fast
        moreover hence "f'  set (replace f [f2] (faces g))"
          by(clarsimp simp: replace6[OF distFg] nf)
        ultimately show ?thesis by blast
      qed
      thus ?thesis ..
    next
      assume  f': "f'   g  f'  f"
      moreover
      hence " f'   f = {}"
        using fg by(blast dest: mgp_edges_disj[OF mgp])
      moreover
      have "Edges_if f r u   f"
        using distf rf uinf
        apply(clarsimp simp del:is_nextElem_edges_eq)
        apply(erule Edges_between_edges[where vs = "[]"])
        by(simp add:pre_split_face_def)
      ultimately
      have "(b,a) : Edges_if f r u 
            (f'' g. final f''  (b,a)   f'')" (is "?A  ?B")
        using 1 f' nf' abf'
        by(simp add:one_final_but_def split:if_split_asm) blast+
      thus ?thesis (is "?A'  ?B'")
      proof
        assume ?A
        moreover
        have "Edges_if f r u  Edges (r # between (vertices f2) r v @ [v])"
          using f2rv by (auto simp:Edges_Cons Edges_append)
        ultimately have ?A' by blast
        thus ?thesis ..
      next
        assume ?B
        then obtain f'' where "f'' g  final f''  (b, a)   f''"
          by blast
        moreover hence "f''  f" using nf by blast
        ultimately have ?B' by (blast intro:in_set_repl)
        thus ?thesis ..
      qed
    qed
    thus ?case by blast
  qed
qed


lemma one_final_but_makeFaceFinal:
 " minGraphProps g; one_final_but g E; E   f; f   g; ¬ final f  
  one_final (makeFaceFinal f g)"
apply(frule minGraphProps11')
apply(clarsimp simp add:one_final_but_def one_final_def makeFaceFinal_def
         makeFaceFinalFaceList_def replace6)
apply(rename_tac f' a b)
apply(erule disjE)
 apply(simp)
apply(subgoal_tac "(a,b)  E")
 prefer 2 apply (simp add:minGraphProps_def edges_disj_def) apply blast
apply(drule_tac x = f' in bspec)
 apply assumption
apply simp
apply(drule_tac x = "(a,b)" in bspec)
 apply simp
apply(fastforce simp add: replace6)
done


lemma one_final_subdivFace':
  "f v n g.
  pre_subdivFace' g f u v n ovs  minGraphProps g  f   g 
  one_final_but g (Edges_if f u v) 
  one_final(subdivFace' g f v n ovs)"
proof (induct ovs)
  case Nil
  hence "pre_split_face f u v []"
    by(simp add:pre_split_face_def pre_subdivFace'_def)
  hence "Edges(u # between (vertices f) u v @ [v])   f"
    by(auto simp add:Edges_between_edges)
  moreover have "¬ final f" using Nil by(simp add:pre_subdivFace'_def)
  ultimately show ?case using Nil by (simp add: one_final_but_makeFaceFinal)
next
  case (Cons ov ovs)
  note IH = Cons(1) and pre = Cons(2) and mgp = Cons(3) and fg = Cons(4)
  note 1 = Cons(5)
  have nf: "¬ final f" and uf: "u  𝒱 f" and vf: "v  𝒱 f"
    using pre by(simp add:pre_subdivFace'_def)+
  show ?case
  proof (cases ov)
    case None
    have pre': "pre_subdivFace' g f u v (Suc n) ovs"
      using None pre by (simp add: pre_subdivFace'_None)
    show ?thesis using None
      by (simp add: IH[OF pre' mgp fg 1])
  next
    case (Some w)
    have uw: "u  w" using pre Some by(clarsimp simp: pre_subdivFace'_def)
    { assume w: "f  v = w" and n: "n = 0"
      from w minGraphProps3[OF mgp fg]
      have vw: "nextElem (vertices f) (hd(vertices f)) v =  w"
        by(simp add:nextVertex_def)
      have 2: "one_final_but g (if u=w then {} else Edges (u # between (vertices f) u w @ [w]))"
          apply (rule one_final_but_antimono[OF 1])
          using uw apply clarsimp
          apply(subgoal_tac "pre_between (vertices f) u v")
           prefer 2
           using pre vf apply(simp add:pre_subdivFace'_def pre_between_def)
          apply(simp add:between_nextElem vw[symmetric])
          apply(fastforce simp add:Edges_Cons Edges_append)
          done
      have pre': "pre_subdivFace' g f u w 0 ovs"
        using pre Some n using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
      have "one_final (subdivFace' g f w 0 ovs)"
        by (simp add: IH[OF pre' mgp fg 2])
    } moreover
    { let ?vs = "[countVertices g..<countVertices g + n]"
      let ?fdg = "splitFace g v w f ?vs"
      let ?Ew = "if u=w then {} else Edges(u # between(vertices (fst(snd ?fdg))) u w @ [w])"
      assume a: "f  v = w  0 < n"
      have pre2: "pre_subdivFace' g f u v n (Some w # ovs)"
        using pre Some by simp
      have fsubg: "𝒱 f  𝒱 g"
        using mgp fg by(simp add: minGraphProps_def faces_subset_def)
      have pre_fdg: "pre_splitFace g v w f ?vs"
           apply (rule pre_subdivFace'_preFaceDiv[OF _ fg _ fsubg])
            using Some pre apply simp
           using a apply (simp)
           done
      have bet: "before (verticesFrom f u) v w" using pre Some
        by(unfold pre_subdivFace'_def) simp
      have 2: "one_final_but(snd(snd ?fdg)) ?Ew"
        using uw apply simp
        apply(rule FaceDivsionGraph_one_final_but[OF mgp pre_fdg _ uw bet uf 1])
        apply(fastforce intro!:prod_eqI)
        done
      note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
      have pre2': "pre_subdivFace' (snd (snd ?fdg)) (fst (snd ?fdg)) u w 0 ovs"
        by (rule pre_subdivFace'_Some1[OF pre2 fg _ fsubg HOL.refl HOL.refl])
           (simp add:a)
      note f2inF = splitFace_add_f21'[OF fg]
      have "one_final (subdivFace' (snd (snd ?fdg)) (fst (snd ?fdg)) w 0 ovs)"
        by (simp add: IH[OF pre2' mgp' f2inF 2])
    } ultimately show ?thesis using Some by (simp add: split_def)
  qed
qed


lemma neighbors_edges:
 "minGraphProps g  a : 𝒱 g  b  set (neighbors g a) = ((a, b)  edges g)"
apply (rule iffI)
 apply (simp add: neighbors_def) apply clarify apply (frule (1) minGraphProps5)
  apply (simp add: vertices_graph)
 apply (simp add: edges_graph_def) apply (intro bexI)
  prefer 2 apply assumption
 apply(simp add:edges_face_eq)
 apply (erule (2) minGraphProps6)
apply (simp add: neighbors_def) apply (simp add: edges_graph_def) apply (elim bexE)
apply (subgoal_tac "x  set (facesAt g a)") apply (simp add: edges_face_def)
apply (rule minGraphProps7) apply simp+ apply (simp add: edges_face_def)
done


lemma no_self_edges: "minGraphProps' g  (a, a)  edges g" apply (simp add: minGraphProps'_def)
apply (induct g) apply simp apply (simp add: edges_graph_def) apply auto apply (drule bspec) apply assumption
apply auto apply (simp add: is_nextElem_def) apply safe apply (simp add: is_sublist_def) apply force
apply (case_tac "vertices x") apply simp apply (case_tac "list" rule: rev_exhaust) apply simp by simp

text‹Requires only @{prop"distinct(vertices f)"} and that g›
has no self-loops.›

lemma duplicateEdge_is_duplicateEdge_eq:
"minGraphProps g  f   g  a  𝒱 f  b  𝒱 f 
 duplicateEdge g f a b = is_duplicateEdge g f a b"
apply (subgoal_tac "distinct (vertices f)")
 prefer 2 apply (simp add: minGraphProps3)
apply(subgoal_tac "a : 𝒱 g")
 prefer 2 apply (simp add: minGraphProps9)
apply (simp add: duplicateEdge_def is_duplicateEdge_def neighbors_edges)
apply (rule iffI)
 apply (simp add: minGraphProps10)
 apply (cases "a = b") apply (simp add: no_self_edges minGraphProps_def)
 apply (rule ccontr)
 apply (simp add: directedLength_def)
 apply (case_tac "is_nextElem (vertices f) a b")
  apply (simp add: is_nextElem_between_empty)
 apply (simp add: is_nextElem_between_empty)
apply (cases "a = b") apply (simp add: no_self_edges minGraphProps_def)
apply (rule ccontr)
apply (simp add: directedLength_def)
apply (elim impE)
  apply (cases "between (vertices f) b a")
   apply (simp add: is_nextElem_between_empty' del:is_nextElem_between_empty)
  apply simp
 apply (cases "between (vertices f) a b")
  apply (simp add: is_nextElem_between_empty' del:is_nextElem_between_empty)
 apply simp
apply (simp add: minGraphProps10)
done

lemma incrIndexList_less_eq:
 "incrIndexList ls m nmax  Suc n < |ls|  ls!n  ls!Suc n"
apply (subgoal_tac "increasing ls") apply (thin_tac "incrIndexList ls m nmax") apply (rule increasing1) apply simp
apply (subgoal_tac "ls = take n ls @ ls!n # [] @ ls!(Suc n) # drop (Suc (Suc n)) ls") apply assumption
apply simp apply (subgoal_tac "n < | ls|") apply (rotate_tac -1) apply (drule id_take_nth_drop)
apply (subgoal_tac "drop (Suc n) ls = ls ! Suc n # drop (Suc (Suc n)) ls") apply simp apply (drule Cons_nth_drop_Suc)
by auto

lemma incrIndexList_less:
 "incrIndexList ls m nmax  Suc n < |ls|  ls!n  ls!Suc n ls!n < ls!Suc n"
apply (drule  incrIndexList_less_eq) by auto

lemma Seed_holds_minGraphProps': "minGraphProps' (Seed p)"
by (simp  add: graph_def Seed_def minGraphProps'_def)

lemma Seed_holds_facesAt_eq: "facesAt_eq (Seed p)"
by (force simp  add: graph_def Seed_def facesAt_eq_def facesAt_def)

lemma minVertex_zero1: "minVertex (Face [0..<Suc z] Final) = 0"
  apply (induct z) apply (simp add: minVertex_def)
  by (simp add: minVertex_def upt_conv_Cons del: upt_Suc)

lemma minVertex_zero2: "minVertex (Face (rev [0..<Suc z]) Nonfinal) = 0"
  apply (induct z) apply (simp add: minVertex_def)
  by (simp add: minVertex_def min_def)


subsection‹Invariants of @{const Seed}

lemma Seed_holds_facesAt_distinct: "facesAt_distinct (Seed p)"
apply(simp add: Seed_def graph_def
                facesAt_distinct_def normFaces_def facesAt_def normFace_def)
apply(simp add: eval_nat_numeral minVertex_zero1 minVertex_zero2 verticesFrom_Def
   fst_splitAt_upt snd_splitAt_upt fst_splitAt_rev snd_splitAt_rev del:upt_Suc)
apply(simp add:upt_conv_Cons del:upt_Suc)
apply simp
done

lemma Seed_holds_faces_subset: "faces_subset (Seed p)"
by (simp add: Seed_def graph_def faces_subset_def)

lemma Seed_holds_edges_sym: "edges_sym (Seed p)"
by (simp add: Seed_def graph_def edges_sym_def edges_graph_def)


lemma Seed_holds_edges_disj: "edges_disj (Seed p)"
using is_nextElem_circ[of "[0..<(p+3)]"]
by (fastforce simp add: Seed_def graph_def edges_disj_def edges_graph_def)


lemma Seed_holds_faces_distinct: "faces_distinct (Seed p)"
apply(simp add: Seed_def graph_def
                faces_distinct_def normFaces_def facesAt_def normFace_def)
apply(simp add: eval_nat_numeral minVertex_zero1 minVertex_zero2 verticesFrom_Def
   fst_splitAt_upt snd_splitAt_upt fst_splitAt_rev snd_splitAt_rev del:upt_Suc)
apply(simp add:upt_conv_Cons del:upt_Suc)
apply simp
done

lemma Seed_holds_faceListAt_len: "faceListAt_len (Seed p)"
by (simp add: Seed_def graph_def faceListAt_len_def)

lemma face_face_op_Seed: "face_face_op(Seed p)"
by (simp add: Seed_def graph_def face_face_op_def)

lemma one_final_Seed: "one_final Seedp"
by(clarsimp simp:Seed_def one_final_def one_final_but_def graph_def)

lemma two_face_Seed: "|faces Seedp|  2"
by(simp add:Seed_def graph_def)

lemma inv_Seed: "inv (Seed p)"
  by (simp add: inv_def minGraphProps_def Seed_holds_minGraphProps'
    Seed_holds_facesAt_eq Seed_holds_facesAt_distinct Seed_holds_faces_subset
    Seed_holds_edges_sym Seed_holds_edges_disj face_face_op_Seed
    Seed_holds_faces_distinct Seed_holds_faceListAt_len
    one_final_Seed two_face_Seed)


lemma pre_subdivFace_indexToVertexList:
assumes mgp: "minGraphProps g" and f: "f  set (nonFinals g)"
  and v: "v  𝒱 f" and e: "e  set (enumerator i |vertices f| )"
  and containsNot: "¬ containsDuplicateEdge g f v e" and i: "2 < i"
shows "pre_subdivFace g f v (indexToVertexList f v e)"
proof -
  from e i have le: "|e| = i" by (auto intro: enumerator_length2)
  from f have fg: "f   g" "¬ final f" by (auto simp: nonFinals_def)
  with mgp have le_vf: "2 < |vertices f|"
    by (simp add: minGraphProps_def minGraphProps'_def)
  from fg mgp have dist_f:"distinct (vertices f)"
    by (simp add: minGraphProps_def minGraphProps'_def)
  with le v i e le_vf fg have "pre_subdivFace_face f v (indexToVertexList f v e)"
    by (rule_tac indexToVertexList_pre_subdivFace_face) simp_all
  moreover
  from dist_f v e le_vf have "indexToVertexList f v e = natToVertexList v f e"
    apply (rule_tac indexToVertexList_natToVertexList_eq)
        apply simp
       apply simp
      prefer 2 apply (simp add: enumerator_not_empty)
     by (auto simp:set_enumerator_simps intro:enumerator_bound)
  moreover
  from e le_vf le i have "incrIndexList e i |vertices f|" by simp
  moreover note mgp containsNot i dist_f v le
  ultimately show ?thesis
    apply (simp add: pre_subdivFace_def)
    apply (simp add: invalidVertexList_def)
    apply (simp add: containsDuplicateEdge_eq containsDuplicateEdge'_def)
    apply (rule allI) apply(rename_tac j) apply (rule impI)
    apply (case_tac "natToVertexList v f e ! j") apply simp
    apply simp
    apply (case_tac "natToVertexList v f e ! Suc j") apply simp
    apply simp
    apply (case_tac "j") apply (simp add: natToVertexList_nth_0 natToVertexList_nth_Suc split: if_split_asm)
     apply (drule_tac spec) apply (rotate_tac -1) apply (erule impE)
      apply (subgoal_tac "e ! 0 < e ! Suc 0") apply assumption
      apply (cases "e") apply simp
      apply simp
      apply (drule incrIndexList_help21)
      apply simp
     apply (subgoal_tac "fe ! 0  v  𝒱 f")
      apply (subgoal_tac "fe ! Suc 0  v  𝒱 f")
       apply (simp add: duplicateEdge_is_duplicateEdge_eq [symmetric] fg)
       apply (rule ccontr)
       apply simp
       apply (cases e) apply simp
       apply simp
       apply (drule incrIndexList_help21) apply clarify apply (drule not_sym) apply (rotate_tac -2) apply simp
      apply (rule nextVertices_in_face) apply simp
     apply (rule nextVertices_in_face) apply simp
    apply simp
    apply (subgoal_tac "natToVertexList v f e ! Suc nat =
        (if e ! nat = e ! Suc nat then None else Some (fe ! Suc nat  v))")
     apply (simp split: if_split_asm)
     apply (subgoal_tac "natToVertexList v f e ! Suc (Suc nat) =
        (if e ! (Suc nat) = e ! Suc (Suc nat) then None else Some (fe ! Suc (Suc nat)  v))")
      apply (simp split: if_split_asm)
      apply (drule spec) apply (rotate_tac -1)  apply (erule impE)
       apply (subgoal_tac "e ! nat < e ! Suc nat") apply assumption
       apply (rule incrIndexList_less) apply assumption apply arith
       apply simp
      apply simp
      apply (subgoal_tac "fe ! Suc nat  v  𝒱 f")
       apply (subgoal_tac "fe ! Suc (Suc nat)  v  𝒱 f")
        apply (simp add: duplicateEdge_is_duplicateEdge_eq [symmetric] fg)
        apply (rule ccontr) apply simp
        apply (rotate_tac -4) apply (erule impE) apply arith
        apply (subgoal_tac "e ! Suc nat < e ! Suc (Suc nat)") apply force
        apply (rule incrIndexList_less) apply assumption apply arith
        apply simp
       apply (rule nextVertices_in_face) apply simp
      apply (rule nextVertices_in_face) apply simp
     apply (rule natToVertexList_nth_Suc) apply simp apply arith
    apply (rule natToVertexList_nth_Suc) apply simp by arith
qed


(* Interlude: increasing properties *)

subsection‹Increasing properties of @{const subdivFace'}

lemma subdivFace'_incr:
assumes Ptrans: "x y z.  Q x y  P y z  P x z"
and mkFin: "f g. f   g  ¬ final f  P g (makeFaceFinal f g)"
and fdg_incr: "g u v f vs.
   pre_splitFace g u v f vs 
   Q g (snd(snd(splitFace g u v f vs)))"
shows
 "f' v n g. pre_subdivFace' g f' v' v n ovl 
  minGraphProps g   f'   g  P g (subdivFace' g f' v n ovl)"
proof (induct ovl)
  case Nil thus ?case by (simp add: pre_subdivFace'_def mkFin)
next
  case (Cons ov ovl) then show ?case
    apply simp
    apply (cases "ov")
     apply (simp)
     apply (rule Cons)
        apply (rule pre_subdivFace'_None)
        apply assumption+
    apply simp
    apply (intro conjI)
     apply rule
     apply simp
     apply (rule Cons)
        apply (rule pre_subdivFace'_Some2)
        apply  assumption+
    apply (rule)
    apply (simp add: split_def)
    apply(rule Ptrans)
    prefer 2
    apply (rule Cons)
       apply (erule (1) pre_subdivFace'_Some1[OF _ _ _ _ HOL.refl HOL.refl])
        apply simp
       apply (simp add: minGraphProps_def faces_subset_def)
      apply (rule splitFace_holds_minGraphProps)
       apply (erule (1) pre_subdivFace'_preFaceDiv)
        apply simp
       apply(simp add: minGraphProps_def faces_subset_def)
      apply assumption
     apply (erule splitFace_add_f21')
    apply(rule fdg_incr)
    apply(erule (1) pre_subdivFace'_preFaceDiv)
     apply simp
    apply(simp add: minGraphProps_def faces_subset_def)
    done
qed

lemma next_plane0_via_subdivFace':
assumes mgp: "minGraphProps g" and gg': "g [next_plane0p]→ g'"
and P: "f v' v n g ovs. minGraphProps g  pre_subdivFace' g f v' v n ovs 
  f   g  P g (subdivFace' g f v n ovs)"
shows "P g g'"
proof -
  from gg'
  obtain f v i "is" e where g': "g' = subdivFace g f is"
    and f: "f  set (nonFinals g)" and v: "v  𝒱 f"
    and e: "e  set (enumerator i |vertices f| )" and i: "2 < i"
    and containsNot: "¬ containsDuplicateEdge g f v e"
    and is_eq: "is = indexToVertexList f v e"
    by (auto simp: next_plane0_def generatePolygon_def image_def split:if_split_asm)
  from f have fg: "f   g" by(simp add:nonFinals_def)
  note pre_add = pre_subdivFace_indexToVertexList[OF mgp f v e containsNot i]
  with g' is_eq have g': "g' = subdivFace' g f v 0 (tl is)"
    by (simp  add: subdivFace_subdivFace'_eq)
  from pre_add is_eq have "is  []"
    by (simp add: pre_subdivFace_def pre_subdivFace_face_def)
  with pre_add v is_eq
  have "pre_subdivFace' g f v v 0 (tl is)"
    by(fastforce simp add:neq_Nil_conv elim:pre_subdivFace_pre_subdivFace')
  from P[OF mgp this fg] g' show ?thesis by simp
qed

lemma next_plane0_incr:
assumes Ptrans: "x y z. Q x y  P y z  P x z"
and mkFin: "f g. f   g  ¬ final f  P g (makeFaceFinal f g)"
and fdg_incr: "g u v f vs.
   pre_splitFace g u v f vs 
   Q g (snd(snd(splitFace g u v f vs)))"
and mgp: "minGraphProps g" and gg': "g [next_plane0p]→ g'"
shows "P g g'"
apply(rule next_plane0_via_subdivFace'[OF mgp gg'])
apply(rule subdivFace'_incr)
     apply(erule (1) Ptrans)
    apply(erule (1) mkFin)
   apply(erule fdg_incr)
  apply assumption+
done

(* End of interlude *)

subsubsection‹Increasing number of faces›

lemma splitFace_incr_faces:
 "pre_splitFace g u v f vs 
 finals(snd(snd(splitFace g u v f vs))) = finals g 
       |nonFinals(snd(snd(splitFace g u v f vs)))| = Suc |nonFinals g|"
apply(unfold pre_splitFace_def)
apply(simp add: splitFace_def split_def finals_def nonFinals_def
      split_face_def filter_replace2 length_filter_replace2)
done


lemma subdivFace'_incr_faces:
 "pre_subdivFace' g f u v n ovs 
  minGraphProps g   f   g 
  |finals (subdivFace' g f v n ovs)| = Suc |finals g| 
  |nonFinals(subdivFace' g f v n ovs)|  |nonFinals g| - Suc 0"
apply(rule subdivFace'_incr)
prefer 4 apply assumption
prefer 4 apply assumption
prefer 4 apply assumption
prefer 2
apply(simp add: pre_subdivFace'_def len_finals_makeFaceFinal
      len_nonFinals_makeFaceFinal)
prefer 2
apply(erule splitFace_incr_faces)
apply (rule conjI)
 apply simp
apply arith
done


lemma next_plane0_incr_faces:
 "minGraphProps g  g [next_plane0p]→ g' 
 |finals g'| = |finals g|+1  |nonFinals g'|  |nonFinals g| - 1"
apply simp
apply(rule next_plane0_incr)
prefer 4 apply assumption
prefer 4 apply assumption
prefer 2
apply(simp add: pre_subdivFace'_def len_finals_makeFaceFinal
      len_nonFinals_makeFaceFinal)
prefer 2
apply(erule splitFace_incr_faces)
apply (rule conjI)
 apply simp
apply arith
done

lemma two_faces_subdivFace':
  "pre_subdivFace' g f u v n ovs  minGraphProps g  f   g 
  |faces g|  2  |faces(subdivFace' g f v n ovs)|  2"
apply(drule (2) subdivFace'_incr_faces)
using len_faces_sum[of g] len_faces_sum[of "subdivFace' g f v n ovs"] by arith

subsection‹Main invariant theorems›

lemma inv_genPoly:
assumes inv: "inv g" and polygen: "g'  set(generatePolygon i v f g)"
and f: "f  set (nonFinals g)" and i: "2 < i" and v: "v  𝒱 f"
shows "inv g'"
proof(unfold inv_def)
  have mgp: "minGraphProps g" and 1: "one_final g"
    using inv by(simp add:inv_def)+
  from polygen
  obtain "is" e where g': "g' = subdivFace g f is"
    and e: "e  set (enumerator i |vertices f| )"
    and containsNot: "¬ containsDuplicateEdge g f v e"
    and is_eq: "is = indexToVertexList f v e"
    by (auto simp: generatePolygon_def)
  have f': "f   g" using f by(simp add:nonFinals_def)
  note pre_add = pre_subdivFace_indexToVertexList[OF mgp f v e containsNot i]
  with g' is_eq have g': "g' = subdivFace' g f v 0 (tl is)"
    by (simp  add: subdivFace_subdivFace'_eq)
  from pre_add is_eq have i_nz: "is  []"
    by (simp add: pre_subdivFace_def pre_subdivFace_face_def)
  with pre_add v i_nz is_eq
  have pre_addSnd: "pre_subdivFace' g f v v 0 (tl is)"
    by(fastforce simp add:neq_Nil_conv elim:pre_subdivFace_pre_subdivFace')
  note 2 = one_final_antimono[OF 1]
  show "minGraphProps g'  one_final g'  |faces g'|  2"
  proof auto
    show "minGraphProps g'" using g' pre_addSnd f
      apply (simp add:nonFinals_def)
      apply (rule subdivFace'_holds_minGraphProps[OF _ _ mgp])
      by (simp_all add: succs)
  next
    show "one_final g'" using g' 1
      by (simp add: one_final_subdivFace'[OF pre_addSnd mgp f' 2])
  next
    show "|faces g'|  2" using g'
      by (simp add: two_faces_subdivFace'[OF pre_addSnd mgp f' inv_two_faces[OF inv]])
  qed
qed


lemma inv_inv_next_plane0: "invariant inv next_plane0p"
proof(clarsimp simp:invariant_def)
  fix g g'
  assume  inv: "inv g" and "g'  set (next_plane0p g)"
  then obtain i v f where "g'  set(generatePolygon i v f g)"
    and "f  set (nonFinals g)" and "2 < i" and "v  𝒱 f"
    by (auto simp: next_plane0_def split: if_split_asm)
  thus "inv g'" using inv by(blast intro:inv_genPoly)
qed

end

Theory PlaneProps

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section "Further Plane Graph Properties"

theory PlaneProps
imports Invariants
begin

subsection @{const final}

lemma plane_final_facesAt:
assumes "inv g" "final g" "v : 𝒱 g" "f  set (facesAt g v)" shows "final f"
proof -
  from assms(1,3,4) have "f   g" by(blast intro: minGraphProps inv_mgp)
  with assms(2) show ?thesis by (rule finalGraph_face)
qed

lemma finalVertexI:
  " inv g;  final g;  v  𝒱 g   finalVertex g v"
by (auto simp add: finalVertex_def nonFinals_def filter_empty_conv plane_final_facesAt)


lemma setFinal_notin_finals:
 " f   g; ¬ final f; minGraphProps g   setFinal f  set (finals g)"
apply(drule minGraphProps11)
apply(cases f)
apply(fastforce simp:finals_def setFinal_def normFaces_def normFace_def
                    verticesFrom_def minVertex_def inj_on_def distinct_map
           split:facetype.splits)
done


subsection @{const degree}

lemma planeN4: "inv g  f   g  3  |vertices f|"
apply(subgoal_tac "2 < | vertices f |")
 apply arith
apply(drule inv_mgp)
apply (erule (1) minGraphProps2)
done


lemma degree_eq:
assumes pl: "inv g" and fin: "final g" and v: "v : 𝒱 g"
shows "degree g v = tri g v + quad g v + except g v"
proof -
  have dist: "distinct(facesAt g v)" using pl v by simp
  have 3: "f  set(facesAt g v). |vertices f| = 3  |vertices f| = 4 
                                  |vertices f|  5"
  proof
    fix f assume f: "f  set (facesAt g v)"
    hence "|vertices f|  3"
      using minGraphProps5[OF inv_mgp[OF pl] v f] planeN4[OF pl] by blast
    thus "|vertices f| = 3  |vertices f| = 4  |vertices f|  5" by arith
  qed
  have "degree g v = |facesAt g v|" by(simp add:degree_def)
  also have " = card(set(facesAt g v))" by (simp add:distinct_card[OF dist])
  also have "set(facesAt g v) = {f  set(facesAt g v). |vertices f| = 3} 
                                {f  set(facesAt g v). |vertices f| = 4} 
                                {f  set(facesAt g v). |vertices f|  5}"
    (is "_ = ?T  ?Q  ?E")
    using 3 by blast
  also have "card(?T  ?Q  ?E) = card ?T + card ?Q + card ?E"
    apply (subst card_Un_disjoint)
    apply simp
    apply simp
    apply fastforce
    apply (subst card_Un_disjoint)
    apply simp
    apply simp
    apply fastforce
    apply simp
    done
  also have " = tri g v + quad g v + except g v" using fin
    by(simp add:tri_def quad_def except_def
                distinct_card[symmetric] distinct_filter[OF dist]
                plane_final_facesAt[OF pl fin v] cong:conj_cong)
  finally show ?thesis .
qed

lemma plane_fin_exceptionalVertex_def:
assumes pl: "inv g" and fin: "final g" and v: "v : 𝒱 g"
shows "exceptionalVertex g v =
 ( | [f  facesAt g v . 5  |vertices f| ] |  0)"
proof -
  have "f. f  set (facesAt g v)  final f"
    by(rule plane_final_facesAt[OF pl fin v])
  then show ?thesis by (simp add: filter_simp exceptionalVertex_def except_def)
qed

lemma not_exceptional:
  "inv g  final g  v : 𝒱 g  f  set (facesAt g v) 
  ¬ exceptionalVertex g v  |vertices f|  4"
by (auto simp add: plane_fin_exceptionalVertex_def except_def filter_empty_conv)


subsection ‹Misc›

lemma in_next_plane0I:
assumes "g'  set (generatePolygon n v f g)" "f  set (nonFinals g)"
        "v  𝒱 f" "3  n" "n < 4+p"
shows "g'  set (next_plane0p g)"
proof -
  from assms have
    "n{3..<4 + p}. g'  set (generatePolygon n v f g)"
    by auto
  with assms have 
    "v𝒱 f. n{3..<4 + p}. g'  set (generatePolygon n v f g)"
    by auto
  with assms have
    "fset (nonFinals g). v𝒱 f. n{3..<4 + p}. g'  set (generatePolygon n v f g)"
    by auto
  moreover have "¬ final g" using assms(2)
    by (auto simp: nonFinals_def finalGraph_def filter_empty_conv)
  ultimately show ?thesis
    by (simp add: next_plane0_def)
qed


lemma next_plane0_nonfinals: "g [next_plane0p]→ g'  nonFinals g  []"
by(auto simp:next_plane0_def finalGraph_def)


lemma next_plane0_ex:
assumes a: "g [next_plane0p]→ g'"
shows "f set(nonFinals g). v  𝒱 f. i  set([3..<Suc(maxGon p)]).
       g'  set (generatePolygon i v f g)"
proof -
  from a have "¬ final g" by (auto simp add: next_plane0_def)
  with a show ?thesis
   by (auto simp add: next_plane0_def nonFinals_def)
qed

lemma step_outside2:
 "inv g  g [next_plane0p]→ g'  ¬ final g'  |faces g'|  2"
apply(frule inv_two_faces)
apply(frule inv_finals_nonempty)
apply(drule inv_mgp)
apply(insert len_faces_sum[of g] len_faces_sum[of g'])
apply(subgoal_tac "|nonFinals g|  0")
 prefer 2 apply(drule next_plane0_nonfinals) apply simp
apply(subgoal_tac "|nonFinals g'|  0")
 prefer 2 apply(simp add:finalGraph_def)
apply(drule (1) next_plane0_incr_faces)
apply(case_tac "|faces g| = 2")
 prefer 2 apply arith
apply(subgoal_tac "|finals g|  0")
 apply arith
apply simp
done


subsection‹Increasing final faces›


lemma set_finals_splitFace[simp]:
 " f   g; ¬ final f  
  set(finals(snd(snd(splitFace g u v f vs)))) = set(finals g)"
apply(auto simp add:splitFace_def split_def finals_def
                split_face_def)
 apply(drule replace5)
 apply(clarsimp)
apply(erule replace4)
apply clarsimp
done


lemma next_plane0_finals_incr:
 "g [next_plane0p]→ g'  f  set(finals g)  f  set(finals g')"
apply(auto simp:next_plane0_def generatePolygon_def split:if_split_asm)
apply(erule subdivFace_pres_finals)
apply (simp add:nonFinals_def)
done

lemma next_plane0_finals_subset:
  "g'  set (next_plane0p g) 
  set (finals g)  set (finals g')"
  by (auto simp add: next_plane0_finals_incr)


lemma next_plane0_final_mono:
  " g'  set (next_plane0p g); f   g; final f   f   g'"
apply(drule next_plane0_finals_subset)
apply(simp add:finals_def)
apply blast
done


subsection‹Increasing vertices›

lemma next_plane0_vertices_subset:
 " g'  set (next_plane0p g); minGraphProps g   𝒱 g  𝒱 g'"
apply(rule next_plane0_incr)
    apply(erule (1) subset_trans)
   apply(simp add: vertices_makeFaceFinal)
  defer apply assumption+
apply (auto simp: splitFace_def split_def vertices_graph)
done


subsection‹Increasing vertex degrees›

lemma next_plane0_incr_faceListAt:
 " g'  set (next_plane0p g); minGraphProps g 
   |faceListAt g|  |faceListAt g'| 
      (v < |faceListAt g|. |faceListAt g ! v|  |faceListAt g' ! v| )"
 (is "_  _  ?Q g g'")
apply(rule next_plane0_incr[where Q = ?Q])
prefer 4 apply assumption
prefer 4 apply assumption
  apply(rule conjI) apply fastforce
  apply(clarsimp)
  apply(erule allE, erule impE, assumption)
  apply(erule_tac x = v in allE, erule impE) apply force
  apply force
 apply(simp add: makeFaceFinal_def makeFaceFinalFaceList_def)
apply (simp add: splitFace_def split_def nth_append nth_list_update)
done


lemma next_plane0_incr_degree:
 " g'  set (next_plane0p g); minGraphProps g; v  𝒱 g 
   degree g v  degree g' v"
apply(frule (1) next_plane0_incr_faceListAt)
apply(frule (1) next_plane0_vertices_subset)
apply(simp add:degree_def facesAt_def)
apply(frule minGraphProps4)
apply(simp add:vertices_graph)
done


subsection‹Increasing @{const except}

lemma next_plane0_incr_except:
assumes "g'  set (next_plane0p g)" "inv g" "v  𝒱 g"
shows "except g v  except g' v"
proof (unfold except_def)
  note inv' = invariantE[OF inv_inv_next_plane0, OF assms(1,2)]
  note mgp = inv_mgp[OF assms(2)] and mgp' = inv_mgp[OF inv']
  note dist = distinct_filter[OF mgp_dist_facesAt[OF mgp v : 𝒱 g]]
  have "v  𝒱 g'"
    using assms(3) next_plane0_vertices_subset[OF assms(1) mgp] by blast
  note dist' = distinct_filter[OF mgp_dist_facesAt[OF mgp' v : 𝒱 g']]
  have "|[ffacesAt g v . final f  5  |vertices f| ]| =
        card{f set(facesAt g v) . final f  5  |vertices f|}"
    (is "?L = card ?M") using distinct_card[OF dist] by simp
  also have "?M = {f  g. v  𝒱 f  final f  5  |vertices f|}"
    by(simp add: minGraphProps_facesAt_eq[OF mgp assms(3)])
  also have " = {f  set(finals g) . v  𝒱 f  5  |vertices f|}"
    by(auto simp:finals_def)
  also have "card   card{f  set(finals g'). v  𝒱 f  5  |vertices f|}"
    (is "_  card ?M")
    apply(rule card_mono)
    apply simp
    using next_plane0_finals_subset[OF assms(1)] by blast
  also have "?M = {f  g' . v  𝒱 f  final f  5  |vertices f|}"
    by(auto simp:finals_def)
  also have " = {f  set(facesAt g' v) . final f  5  |vertices f|}"
    by(simp add: minGraphProps_facesAt_eq[OF mgp' v  𝒱 g'])
  also have "card  =
    |[f  facesAt g' v . final f  5  |vertices f| ]|" (is "_ = ?R")
    using distinct_card[OF dist'] by simp
  finally show "?L  ?R" .
qed


subsection‹Increasing edges›

lemma next_plane0_set_edges_subset:
  " minGraphProps g;  g [next_plane0p]→ g'   edges g  edges g'"
apply(rule next_plane0_incr)
    apply(erule (1) subset_trans)
   apply(simp add: edges_makeFaceFinal)
  apply(erule snd_snd_splitFace_edges_incr)
 apply assumption+
done


subsection‹Increasing final vertices›

(*
This should really be proved via the (unproven) invariant
v : f ⟹ ((g,v).f).(f.v) = v
*)

declare  atLeastLessThan_iff[iff]

lemma next_plane0_incr_finV:
 "g'  set (next_plane0p g); minGraphProps g 
   v  𝒱 g. v  𝒱 g' 
        ((f g. v  𝒱 f  final f) 
         (f g'. v  𝒱 f  f   g))" (is "_  _  ?Q g g'")
apply(rule next_plane0_incr[where Q = ?Q and g=g and g'=g'])
prefer 4 apply assumption
prefer 4 apply assumption
  apply fast
 apply(clarsimp simp:makeFaceFinal_def vertices_graph makeFaceFinalFaceList_def)
 apply(drule replace5)
 apply(erule disjE)apply blast
 apply(simp add:setFinal_def)
apply(unfold pre_splitFace_def)
apply(clarsimp simp:splitFace_def split_def vertices_graph)
apply(rule conjI)
 apply(clarsimp simp:split_face_def vertices_graph atLeastLessThan_def)
 apply(blast dest:inbetween_inset)
apply(clarsimp)
apply(erule disjE[OF replace5]) apply blast
apply(clarsimp simp:split_face_def vertices_graph)
apply(blast dest:inbetween_inset)
done


lemma next_plane0_finalVertex_mono:
 "g'  set (next_plane0p g); inv g; u  𝒱 g; finalVertex g u 
   finalVertex g' u"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(subgoal_tac "u  𝒱 g'")
 prefer 2 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply(clarsimp simp:finalVertex_def minGraphProps_facesAt_eq[OF inv_mgp])
apply(blast dest:next_plane0_incr_finV inv_mgp)
done


subsection‹Preservation of @{const facesAt} at final vertices›

lemma next_plane0_finalVertex_facesAt_eq:
 "g'  set (next_plane0p g); inv g; v  𝒱 g; finalVertex g v 
   set(facesAt g' v) = set(facesAt g v)"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(subgoal_tac "v  𝒱 g'")
 prefer 2 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply(clarsimp simp:finalVertex_def minGraphProps_facesAt_eq[OF inv_mgp])
by(blast dest:next_plane0_incr_finV next_plane0_final_mono inv_mgp)


lemma next_plane0_len_filter_eq:
assumes "g'  set (next_plane0p g)" "inv g" "v  𝒱 g" "finalVertex g v"
shows "|filter P (facesAt g' v)| = |filter P (facesAt g v)|"
proof -
  note inv' = invariantE[OF inv_inv_next_plane0, OF assms(1,2)]
  note mgp = inv_mgp[OF assms(2)] and mgp' = inv_mgp[OF inv']
  note dist = distinct_filter[OF mgp_dist_facesAt[OF mgp v : 𝒱 g]]
  have "v  𝒱 g'"
    using assms(3) next_plane0_vertices_subset[OF assms(1) mgp] by blast
  note dist' = distinct_filter[OF mgp_dist_facesAt[OF mgp' v : 𝒱 g']]
  have "|filter P (facesAt g' v)| = card{f  set(facesAt g' v) . P f}"
    using distinct_card[OF dist'] by simp
  also have " = card{f  set(facesAt g v) . P f}"
    by(simp add: next_plane0_finalVertex_facesAt_eq[OF assms])
  also have " = |filter P (facesAt g v)|"
    using distinct_card[OF dist] by simp
  finally show ?thesis .
qed


subsection‹Properties of @{const subdivFace'}

lemma new_edge_subdivFace':
  "f v n g.
  pre_subdivFace' g f u v n ovs  minGraphProps g  f   g 
  subdivFace' g f v n ovs = makeFaceFinal f g 
  (f'   (subdivFace' g f v n ovs) - ( g - {f}).
   e   f'. e   g)"
proof (induct ovs)
  case Nil thus ?case by simp
next
  case (Cons ov ovs)
  note IH = Cons(1) and pre = Cons(2) and mgp = Cons(3) and fg = Cons(4)
  have uf: "u  𝒱 f" and vf: "v  𝒱 f" and distf: "distinct (vertices f)"
    using pre by(simp add:pre_subdivFace'_def)+
  note distFg = minGraphProps11'[OF mgp]
  show ?case
  proof (cases ov)
    case None
    have pre': "pre_subdivFace' g f u v (Suc n) ovs"
      using None pre by (simp add: pre_subdivFace'_None)
    show ?thesis using None
      by (simp add: IH[OF pre' mgp fg])
  next
    case (Some w)
    note pre = pre[simplified Some]
    have uvw: "before (verticesFrom f u) v w"
      using pre by(simp add:pre_subdivFace'_def)
    have uw: "u  w" using pre by(clarsimp simp: pre_subdivFace'_def)
    { assume w: "f  v = w" and n: "n = 0"
      have pre': "pre_subdivFace' g f u w 0 ovs"
        using pre Some n using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
      note IH[OF pre' mgp fg]
    } moreover
    { let ?vs = "[countVertices g..<countVertices g + n]"
      let ?fdg = "splitFace g v w f ?vs"
      let  ?f1 = "fst ?fdg" and ?f2 = "fst(snd ?fdg)" and ?g' = "snd(snd ?fdg)"
      let ?g'' = "subdivFace' ?g' ?f2 w 0 ovs"
      let ?fvw = "between(vertices f) v w" and ?fwv = "between(vertices f) w v"
      assume a: "f  v = w  0 < n"
      have fsubg: "𝒱 f  𝒱 g"
        using mgp fg by(simp add: minGraphProps_def faces_subset_def)
      have pre_fdg: "pre_splitFace g v w f ?vs"
           apply (rule pre_subdivFace'_preFaceDiv[OF pre fg _ fsubg])
           using a by (simp)
      hence "v  w" and "w  𝒱 f" by(unfold pre_splitFace_def)simp+
      have f1: "?f1= fst(split_face f v w ?vs)"
        and f2: "?f2 = snd(split_face f v w ?vs)"
        by(auto simp add:splitFace_def split_def)
      note pre_split = pre_splitFace_pre_split_face[OF pre_fdg]
      have E1: " ?f1 = Edges (w # rev ?vs @ [v])  Edges (v # ?fvw @ [w])"
        using f1 by(simp add:edges_split_face1[OF pre_split])
      have E2: " ?f2 = Edges (v # ?vs @ [w])  Edges (w # ?fwv @ [v])"
        by(simp add:splitFace_def split_def
            edges_split_face2[OF pre_split])
      note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
      note distFg' = minGraphProps11'[OF mgp']
      have pre': "pre_subdivFace' ?g' ?f2 u w 0 ovs"
        by (rule pre_subdivFace'_Some1[OF pre fg _ fsubg HOL.refl HOL.refl])
           (simp add:a)
      note f2inF = splitFace_add_f21'[OF fg]
      have 1: "e   ?f1. e   g"
      proof cases
        assume "rev ?vs = []"
        hence "(w,v)   ?f1  (w,v)   g" using pre_fdg E1
          by(unfold pre_splitFace_def) (auto simp:Edges_Cons)
        thus ?thesis by blast
      next
        assume "rev ?vs  []"
        then obtain x xs where rvs: "rev ?vs = x#xs"
          by(auto simp only:neq_Nil_conv)
        hence "(w,x)   ?f1" using E1 by (auto simp:Edges_Cons)
        moreover have "(w,x)   g"
        proof -
          have "x  set(rev ?vs)" using rvs by simp
          hence "x  countVertices g" by simp
          hence "x  𝒱 g" by(induct g) (simp add:vertices_graph_def)
          thus ?thesis
            by (auto simp:edges_graph_def)
               (blast dest: in_edges_in_vertices minGraphProps9[OF mgp])
        qed
        ultimately show ?thesis by blast
      qed
      have 2: "e   ?f2. e   g"
      proof cases
        assume "?vs = []"
        hence "(v,w)   ?f2  (v,w)   g" using pre_fdg E2
          by(unfold pre_splitFace_def) (auto simp:Edges_Cons)
        thus ?thesis by blast
      next
        assume "?vs  []"
        then obtain x xs where vs: "?vs = x#xs"
          by(auto simp only:neq_Nil_conv)
        hence "(v,x)   ?f2" using E2 by (auto simp:Edges_Cons)
        moreover have "(v,x)   g"
        proof -
          have "x  set ?vs" using vs by simp
          hence "x  countVertices g" by simp
          hence "x  𝒱 g" by(induct g) (simp add:vertices_graph_def)
          thus ?thesis
            by (auto simp:edges_graph_def)
               (blast dest: in_edges_in_vertices minGraphProps9[OF mgp])
        qed
        ultimately show ?thesis by blast
      qed
      have fdg: "(?f1,?f2,?g') = splitFace g v w f ?vs" by auto
      hence Fg': " ?g' = {?f1,?f2}  ( g - {f})"
        using set_faces_splitFace[OF mgp fg pre_fdg] by blast
      have "f'   ?g'' - ( g - {f}). e   f'. e   g"
      proof (clarify)
        fix f' assume f'g'': "f'   ?g''" and f'ng: "f'   g - {f}"
        from IH[OF pre' mgp' f2inF]
        show "e   f'. e   g"
        proof
          assume "?g'' = makeFaceFinal ?f2 ?g'"
          hence "f' = setFinal ?f2  f' = ?f1" (is "?A  ?B")
            using f'g'' Fg' f'ng
            by(auto simp:makeFaceFinal_def makeFaceFinalFaceList_def
              distinct_set_replace[OF distFg'])
          thus ?thesis
          proof
            assume ?A thus ?thesis using 2 by(simp)
          next
            assume ?B thus ?thesis using 1 by blast
          qed
        next
          assume A: "f'   ?g'' - ( ?g' - {?f2}).
                     e   f'. e   ?g'"
          show ?thesis
          proof cases
            assume "f'  {?f1,?f2}"
            thus ?thesis using 1 2 by blast
          next
            assume "f'  {?f1,?f2}"
            hence "e f'. e   ?g'"
              using A f'g'' f'ng Fg' by simp
            with splitFace_edges_incr[OF pre_fdg fdg]
            show ?thesis by blast
          qed
        qed
      qed
    }
    ultimately show ?thesis using Some by(auto simp: split_def)
  qed
qed


lemma dist_edges_subdivFace':
  "pre_subdivFace' g f u v n ovs  minGraphProps g  f   g 
  subdivFace' g f v n ovs = makeFaceFinal f g 
  (f'   (subdivFace' g f v n ovs) - ( g - {f}).  f'   f)"
apply(drule (2) new_edge_subdivFace')
apply(erule disjE)
 apply blast
apply(rule disjI2)
apply(clarify)
apply(drule bspec)
 apply fast
apply(simp add:edges_graph_def)
by(blast)



lemma between_last: " distinct(vertices f); u  𝒱 f  
   between (vertices f) u (last (verticesFrom f u)) =
   butlast(tl(verticesFrom f u))"
apply(drule split_list)
apply (fastforce dest: last_in_set
  simp: between_def verticesFrom_Def split_def
       last_append butlast_append fst_splitAt_last)
done

(* FIXME move condition to pre_addfacesnd? *)
lemma final_subdivFace': "f u n g. minGraphProps g 
  pre_subdivFace' g f r u n ovs  f   g 
  (ovs = []  n=0  u = last(verticesFrom f r)) 
  f'  set(finals(subdivFace' g f u n ovs)) - set(finals g).
   (f-1  r,r)   f'   |vertices f'| =
      n + |ovs| + (if r=u then 1 else |between (vertices f) r u| + 2)"
proof (induct ovs)
  case Nil show ?case (is "f'  ?F. ?P f'")
  proof
    show "?P (setFinal f)" (is "?A  ?B")
    proof
      show "?A" using Nil
        by(simp add:pre_subdivFace'_def prevVertex_in_edges
          del:is_nextElem_edges_eq)
      show  "?B"
        using Nil mgp_vertices3[OF Nil(1,3)]
        by(simp add:  setFinal_def between_last pre_subdivFace'_def)
    qed
  next
    show "setFinal f  ?F" using Nil
      by(simp add:pre_subdivFace'_def setFinal_notin_finals minGraphProps11')
  qed
next
  case (Cons ov ovs)
  note IH = Cons(1) and mgp = Cons(2) and pre = Cons(3) and fg = Cons(4)
    and mt = Cons(5)
  have "r  𝒱 f" and "u  𝒱 f" and distf: "distinct (vertices f)"
    using pre by(simp add:pre_subdivFace'_def)+
  show ?case
  proof (cases ov)
    case None
    have pre': "pre_subdivFace' g f r u (Suc n) ovs"
      using None pre by (simp add: pre_subdivFace'_None)
    have "ovs  []" using pre None by (auto simp: pre_subdivFace'_def)
    thus ?thesis using None IH[OF mgp pre' fg] by simp
  next
    case (Some v)
    note pre = pre[simplified Some]
      have ruv: "before (verticesFrom f r) u v" and "r  v"
        using pre by(simp add:pre_subdivFace'_def)+
    show ?thesis
    proof (cases "f  u = v  n = 0")
      case True
      have pre': "pre_subdivFace' g f r v 0 ovs"
        using pre True using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
      have mt: "ovs = []  0 = 0  v = last (verticesFrom f r)"
        using pre by(clarsimp simp:pre_subdivFace'_def)
      show ?thesis using Some True IH[OF mgp pre' fg mt] r  v
        by(auto simp: between_next_empty[OF distf]
          unroll_between_next2[OF distf r  𝒱 f u  𝒱 f])
    next
      case False
      let ?vs = "[countVertices g..<countVertices g + n]"
      let ?fdg = "splitFace g u v f ?vs"
      let ?g' = "snd(snd ?fdg)" and ?f2 = "fst(snd ?fdg)"
      let ?fvu = "between (vertices f) v u"
      have False': "f  u = v  n  0" using False by auto
      have VfVg: "𝒱 f  𝒱 g" using mgp fg
          by (simp add: minGraphProps_def faces_subset_def)
      note pre_fdg = pre_subdivFace'_preFaceDiv[OF pre fg False' VfVg]
      hence "u  v" and "v  𝒱 f" and disj: "𝒱 f  set ?vs = {}"
        by(unfold pre_splitFace_def)simp+
      hence vvs: "v  set ?vs" by auto
      have vf2: "vertices ?f2 = [v] @ ?fvu @ u # ?vs"
        by(simp add:split_face_def splitFace_def split_def)
      hence betuvf2: "between (vertices ?f2) u v = ?vs"
        using splitFace_distinct1[OF pre_fdg]
        by(simp add: between_back)
      have betrvf2: "r  u  between (vertices ?f2) r v =
        between (vertices f) r u @ [u] @ ?vs"
      proof -
        assume "ru"
        have r: "r  set (between (vertices f) v u)"
          using ru rv uv v  𝒱 f r  𝒱 f distf ruv
          by(blast intro:rotate_before_vFrom before_between)
        have "between (vertices f) v u =
          between (vertices f) v r @ [r] @ between (vertices f) r u"
          using split_between[OF distf v  𝒱 f u  𝒱 f r] rv
          by simp
        moreover hence "v  set (between (vertices f) r u)"
          using between_not_r1[OF distf, of v u] by simp
        ultimately show ?thesis using vf2 rv uv vvs
          by (simp add: between_back between_not_r2[OF distf])
      qed
      note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
      note f2g = splitFace_add_f21'[OF fg]
      note pre' = pre_subdivFace'_Some1[OF pre fg False' VfVg HOL.refl HOL.refl]
      from pre_fdg have "v  𝒱 f" and disj: "𝒱 f  set ?vs = {}"
        by(unfold pre_splitFace_def, simp)+
      have fr: "?f2-1  r = f-1  r"
      proof -
        note pre_split = pre_splitFace_pre_split_face[OF pre_fdg]
        have rinf2: "r  𝒱 ?f2"
        proof cases
          assume "r = u" thus ?thesis by(simp add:vf2)
        next
          assume "r  u"
          hence "r  set ?fvu" using distf v : 𝒱 f rv r : 𝒱 f ruv
            by(blast intro: before_between rotate_before_vFrom)
          thus ?thesis by(simp add:vf2)
        qed
        have E2: " ?f2 = Edges (u # ?vs @ [v]) 
                             Edges (v # ?fvu @ [u])"
          by(simp add:splitFace_def split_def
            edges_split_face2[OF pre_split])
        moreover have "(?f2-1  r, r)   ?f2"
          by(blast intro: prevVertex_in_edges rinf2
            splitFace_distinct1[OF pre_fdg])
        moreover have "(?f2-1  r, r)  Edges (u # ?vs @ [v])"
        proof -
          have "r  set ?vs" using r : 𝒱 f disj by blast
          thus ?thesis using r  v
            by(simp add:Edges_Cons Edges_append notinset_notinEdge2) arith
        qed
        ultimately have "(?f2-1  r, r)  Edges (v # ?fvu @ [u])" by blast
        hence "(?f2-1  r, r)   f" using pre_split_face_symI[OF pre_split]
          by(blast intro: Edges_between_edges)
        hence eq: "f  (?f2-1  r) = r" and inf: "?f2-1  r  𝒱 f"
          by(simp add:edges_face_eq)+
        have "?f2-1  r = f-1  (f  (?f2-1  r))"
          using prevVertex_nextVertex[OF distf inf] by simp
        also have " = f-1  r" using eq by simp
        finally show ?thesis .
      qed
      hence mt: "ovs = []  0 = 0  v = last (verticesFrom ?f2 r)"
        using pre' pre by(auto simp:pre_subdivFace'_def splitFace_def
          split_def last_vFrom)
      from IH[OF mgp' pre' f2g mt] r  v obtain f' :: face where
        f: "f'  set(finals(subdivFace' ?g' ?f2 v 0 ovs)) - set(finals ?g')"
        and ff: "(?f2-1  r, r)   f'"
        "|vertices f'| = |ovs| + |between (vertices ?f2) r v| + 2"
        by simp blast
      show ?thesis (is "f'  ?F. ?P f'")
      proof
        show "f'  ?F" using f pre Some fg
          by(simp add:False split_def pre_subdivFace'_def)
        show "?P f'" using ff fr by(clarsimp simp:betuvf2 betrvf2)
      qed
    qed
  qed
qed


lemma Seed_max_final_ex:
 "fset (finals (Seed p)). |vertices f| = maxGon p"
  by (simp add: Seed_def graph_max_final_ex)

lemma max_face_ex: assumes a: "Seedp [next_plane0p]→* g"
shows "f  set (finals g). |vertices f| = maxGon p"
using a
proof (induct rule: RTranCl_induct)
  case refl then show ?case using Seed_max_final_ex by simp
next
  case (succs g g')
  then obtain f where f: "fset (finals g)" and "|vertices f| = maxGon p"
    by auto
  moreover from succs(1) f have "fset (finals g')" by (rule next_plane0_finals_incr)
  ultimately show ?case by auto
qed


end

Theory ListSum

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section "Summation Over Lists"

theory ListSum
imports ListAux
begin

primrec ListSum :: "'b list  ('b  'a::comm_monoid_add)  'a::comm_monoid_add"  where
  "ListSum [] f = 0"
| "ListSum (l#ls) f = f l + ListSum ls f"

syntax "_ListSum" :: "idt  'b list  ('a::comm_monoid_add)  
  ('a::comm_monoid_add)"    ("∑⇘__ _" [0, 0, 10] 10)
translations "∑xxs f" == "CONST ListSum xs (λx. f)" 

lemma [simp]: "(v  V 0) = (0::nat)" by (induct V) simp_all

lemma ListSum_compl1: 
  "(x  [xxs. ¬ P x] f x) + (x  [xxs. P x] f x) = (x  xs (f x::nat))" 
 by (induct xs) simp_all

lemma ListSum_compl2: 
  "(x   [xxs. P x] f x) + (x   [xxs. ¬ P x] f x) = (x  xs (f x::nat))" 
 by (induct xs) simp_all

lemmas ListSum_compl = ListSum_compl1 ListSum_compl2


lemma ListSum_conv_sum:
 "distinct xs  ListSum xs f =  sum f (set xs)"
by(induct xs) simp_all


lemma listsum_cong:
 " xs = ys; y. y  set ys  f y = g y 
   ListSum xs f = ListSum ys g"
apply simp
apply(erule thin_rl)
by (induct ys) simp_all


lemma strong_listsum_cong[cong]:
 " xs = ys; y. y  set ys =simp=> f y = g y 
   ListSum xs f = ListSum ys g"
by(auto simp:simp_implies_def intro!:listsum_cong)


lemma ListSum_eq [trans]: 
  "(v. v  set V  f v = g v)  (v  V f v) = (v  V g v)" 
by(auto intro!:listsum_cong)


lemma ListSum_disj_union: 
  "distinct A  distinct B  distinct C  
  set C = set A  set B   
  set A  set B = {} 
  (a  C (f a)) = (a  A f a) + (a  B (f a::nat))"
by (simp add: ListSum_conv_sum sum.union_disjoint)


lemma listsum_const[simp]: 
  "(x  xs k) = length xs * k"
by (induct xs) (simp_all add: ring_distribs)

lemma ListSum_add: 
  "(x  V f x) + (x  V g x) = (x  V (f x + (g x::nat)))" 
  by (induct V) auto

lemma ListSum_le: 
  "(v. v  set V  f v  g v)  (v  V f v)  (v  V (g v::nat))"
proof (induct V)
  case Nil then show ?case by simp
next
  case (Cons v V) then have "(v  V f v)  (v  V g v)" by simp
  moreover from Cons have "f v  g v" by simp
  ultimately show ?case by simp
qed

lemma ListSum1_bound:
 "a  set F  (d a::nat) (f  F d f)"
by (induct F) auto

end

Theory Tame

(*  Author:     Gertrud Bauer, Tobias Nipkow
The definitions should be identical to the ones in the file
http://code.google.com/p/flyspeck/source/browse/trunk/text_formalization/tame/tame_defs.hl
by Thomas Hales. Modulo a few inessential rearrangements.
*)

section‹Tameness›

theory Tame
imports Graph ListSum
begin


subsection ‹Constants \label{sec:TameConstants}›

definition squanderTarget :: "nat" where
 "squanderTarget  15410" 

definition excessTCount :: "nat" (*<*) ("𝖺")(*>*)where

 "𝖺  6295"

definition squanderVertex :: "nat  nat  nat" (*<*)("𝖻")(*>*)where

 "𝖻 p q  if p = 0  q = 3 then 6177 
     else if p = 0  q = 4 then  9696
     else if p = 1  q = 2 then  6557 
     else if p = 1  q = 3 then  6176 
     else if p = 2  q = 1 then  7967 
     else if p = 2  q = 2 then  4116 
     else if p = 2  q = 3 then 12846 
     else if p = 3  q = 1 then  3106 
     else if p = 3  q = 2 then  8165 
     else if p = 4  q = 0 then  3466 
     else if p = 4  q = 1 then  3655 
     else if p = 5  q = 0 then   395 
     else if p = 5  q = 1 then 11354 
     else if p = 6  q = 0 then  6854 
     else if p = 7  q = 0 then 14493 
     else squanderTarget"

definition squanderFace :: "nat  nat" (*<*)("𝖽")(*>*)where

 "𝖽 n  if n = 3 then 0
     else if n = 4 then 2058
     else if n = 5 then 4819
     else if n = 6 then 7120
     else squanderTarget" 

text_raw‹
\index{𝖺›}
\index{𝖻›}
\index{𝖽›}
›

subsection‹Separated sets of vertices \label{sec:TameSeparated}›


text ‹A set of vertices $V$ is {\em separated},
\index{separated}
\index{separated›}
iff the following conditions hold:
›

text ‹2. No two vertices in V are adjacent:›

definition separated2 :: "graph  vertex set  bool" where
 "separated2 g V  v  V. f  set (facesAt g v). fv  V"

text ‹3. No two vertices lie on a common quadrilateral:›

definition separated3 :: "graph  vertex set  bool" where
 "separated3 g V  
     v  V. f  set (facesAt g v). |vertices f|4  𝒱 f  V = {v}"

text ‹A set of vertices  is  called {\em separated},
\index{separated} \index{separated›}
iff no two vertices are adjacent or lie on a common quadrilateral:›

definition separated :: "graph  vertex set  bool" where
 "separated g V  separated2 g V  separated3 g V"

subsection‹Admissible weight assignments\label{sec:TameAdmissible}›

text ‹
A weight assignment w :: face ⇒ nat› 
assigns a natural number to every face.

\index{admissible›}
\index{admissible weight assignment}

We formalize the admissibility requirements as follows:
›

definition admissible1 :: "(face  nat)  graph  bool" where  
 "admissible1 w g  f   g. 𝖽 |vertices f|  w f"

definition admissible2 :: "(face  nat)  graph  bool" where  
 "admissible2 w g  
  v  𝒱 g. except g v = 0  𝖻 (tri g v) (quad g v)  (ffacesAt g v w f)"

definition admissible3 :: "(face  nat)  graph  bool" where  
 "admissible3 w g  
  v  𝒱 g. vertextype g v = (5,0,1)  (ffilter triangle (facesAt g v) w(f))  𝖺"


text ‹Finally we define admissibility of weights functions.›


definition admissible :: "(face  nat)  graph  bool" where  
 "admissible w g  admissible1 w g  admissible2 w g  admissible3 w g"
 
subsection‹Tameness \label{sec:TameDef}›

definition tame9a :: "graph  bool" where
"tame9a g  f   g. 3  |vertices f|  |vertices f|  6"

definition tame10 :: "graph  bool" where
"tame10 g = (let n = countVertices g in 13  n  n  15)"

definition tame10ub :: "graph  bool" where
"tame10ub g = (countVertices g  15)"

definition tame11a :: "graph  bool" where
"tame11a g = (v  𝒱 g. 3  degree g v)"

definition tame11b :: "graph  bool" where
"tame11b g = (v  𝒱 g. degree g v  (if except g v = 0 then 7 else 6))"

definition tame12o :: "graph  bool" where
"tame12o g =
 (v  𝒱 g. except g v  0  degree g v = 6  vertextype g v = (5,0,1))"
 
text ‹7. There exists an admissible weight assignment of total
weight less than the target:›

definition tame13a :: "graph  bool" where
"tame13a g = (w. admissible w g  (f  faces g w f) < squanderTarget)"

text ‹Finally we define the notion of tameness.›

definition tame :: "graph  bool" where
"tame g  tame9a g  tame10 g  tame11a g  tame11b g  tame12o g  tame13a g"
(*<*)
end
(*>*)

Theory Plane1Props

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

theory Plane1Props
imports Plane1 PlaneProps Tame
begin

lemma next_plane_subset:
  "f   g. vertices f  [] 
   set (next_planep g)  set (next_plane0p g)"
apply(clarsimp simp:next_plane0_def next_plane_def minimalFace_def finalGraph_def)
apply(rule_tac x = "minimal (size  vertices) (nonFinals g)" in bexI)
 apply(rule_tac x = "minimalVertex g (minimal (size  vertices) (nonFinals g))" in bexI)
  apply blast
 apply(subgoal_tac "fset (nonFinals g). vertices f  []")
  apply(simp add:minimalVertex_def)
 apply(simp add:nonFinals_def)
apply simp
done

lemma mgp_next_plane0_if_next_plane:
  "minGraphProps g  g [next_planep]→ g'  g [next_plane0p]→ g'"
using next_plane_subset by(blast dest: mgp_vertices_nonempty)

lemma inv_inv_next_plane: "invariant inv next_planep"
apply(rule inv_subset[OF inv_inv_next_plane0])
apply(blast dest: mgp_next_plane0_if_next_plane[OF inv_mgp])
done

end

Theory Generator

(*  Author: Gertrud Bauer, Tobias Nipkow *)

section ‹Enumeration of Tame Plane Graphs›

theory Generator
imports Plane1 Tame
begin


text‹\paragraph{Lower bounds for total weight}›


definition faceSquanderLowerBound :: "graph  nat" where
"faceSquanderLowerBound g f  finals g 𝖽 |vertices f|"

definition d3_const :: nat where
"d3_const == 𝖽 3"

definition  d4_const :: nat where
"d4_const == 𝖽 4"

definition excessAtType :: "nat  nat  nat  nat" where
"excessAtType t q e 
    if e = 0 then if 7 < t + q then squanderTarget
                  else 𝖻 t q - t * d3_const - q * d4_const
    else if t + q + e  6 then 0
         else if t=5 then 𝖺 else squanderTarget"

declare d3_const_def[simp] d4_const_def[simp]


definition ExcessAt :: "graph  vertex  nat" where
 "ExcessAt g v  if ¬ finalVertex g v then 0
     else excessAtType (tri g v) (quad g v) (except g v)"


definition ExcessTable :: "graph  vertex list  (vertex × nat) list" where
 "ExcessTable g vs 
     [(v, ExcessAt g v). v  [v  vs. 0 < ExcessAt g v ]]"
text‹Implementation:›
lemma [code]:
  "ExcessTable g =
   List.map_filter (λv. let e = ExcessAt g v in if 0 < e then Some (v, e) else None)"
 by (rule ext) (simp add: ExcessTable_def map_filter_def)

(* FIXME delete stupid removeKeyList *)
definition deleteAround :: "graph  vertex  (vertex × nat) list  (vertex × nat) list" where
 "deleteAround g v ps 
      let fs = facesAt g v;
      ws =ffs if |vertices f| = 4 then [fv, f2v] else [fv] in
      removeKeyList ws ps"
text‹Implementation:›
lemma [code]: "deleteAround g v ps =
      (let vs = (λf. let n = fv
                     in if |vertices f| = 4 then [n, fn] else [n])
       in removeKeyList (concat(map vs (facesAt g v))) ps)"
  by (simp only: concat_map_singleton Let_def deleteAround_def nextV2)

lemma length_deleteAround: "length (deleteAround g v ps)  length ps"
  by (auto simp only: deleteAround_def length_removeKeyList Let_def)

function ExcessNotAtRec :: "(nat, nat) table  graph  nat" where
 "ExcessNotAtRec [] = (λg. 0)"
 | "ExcessNotAtRec ((x, y)#ps) = (λg.  max (ExcessNotAtRec ps g)
         (y + ExcessNotAtRec (deleteAround g x ps) g))"
by pat_completeness auto
termination by (relation "measure size") 
  (auto simp add: length_deleteAround less_Suc_eq_le)

definition ExcessNotAt :: "graph  vertex option  nat" where
 "ExcessNotAt g v_opt 
     let ps = ExcessTable g (vertices g) in
     case v_opt of None   ExcessNotAtRec ps g
      | Some v  ExcessNotAtRec (deleteAround g v ps) g"

definition squanderLowerBound :: "graph  nat" where
 "squanderLowerBound g   faceSquanderLowerBound g + ExcessNotAt g None"



text‹\paragraph{Tame graph enumeration}›

definition is_tame13a :: "graph  bool" where
"is_tame13a g  squanderLowerBound g < squanderTarget"

definition notame :: "graph  bool" where
"notame g  ¬ (tame10ub g  tame11b g)"

definition notame7 :: "graph  bool" where
"notame7 g  ¬ (tame10ub g  tame11b g  is_tame13a g)"

definition generatePolygonTame :: "nat  vertex  face  graph  graph list" where
"generatePolygonTame n v f g 
     let
     enumeration = enum n |vertices f|;
     enumeration = [is  enumeration. ¬ containsDuplicateEdge g f v is];
     vertexLists = [indexToVertexList f v is. is  enumeration]
     in
     [g'  [subdivFace g f vs. vs  vertexLists] . ¬ notame g']"

definition polysizes :: "nat  graph  nat list" where
"polysizes p g 
    let lb = squanderLowerBound g in
    [n  [3 ..< Suc(maxGon p)]. lb + 𝖽 n < squanderTarget]"

definition next_tame0 :: "nat  graph  graph list" ("next'_tame0⇘_") where
"next_tame0p g 
     let fs = nonFinals g in
     if fs = [] then []
     else let f = minimalFace fs; v = minimalVertex g f
          ini  polysizes p g generatePolygonTame i v f g"

text‹\noindent Extensionally, @{const next_tame0} is just
@{term"filter P  next_plane p"} for some suitable P›. But
efficiency suffers considerably if we first create many graphs and
then filter out the ones not in @{const polysizes}.›

end

Theory TameProps

(* Author:     Tobias Nipkow
*)

section‹Tame Properties›

theory TameProps
imports Tame RTranCl
begin

lemma length_disj_filter_le: "x  set xs. ¬(P x  Q x) 
 length(filter P xs) + length(filter Q xs)  length xs"
by(induct xs) auto

lemma tri_quad_le_degree: "tri g v + quad g v  degree g v"
proof -
  let ?fins = "[f  facesAt g v . final f]"
  have "tri g v + quad g v =
        |[f  ?fins . triangle f]| + |[f  ?fins. |vertices f| = 4]|"
    by(simp add:tri_def quad_def)
  also have "  |[f  facesAt g v. final f]|"
    by(rule length_disj_filter_le) simp
  also have "  |facesAt g v|" by(rule length_filter_le)
  finally show ?thesis by(simp add:degree_def)
qed

lemma faceCountMax_bound:
 " tame g; v  𝒱 g   tri g v + quad g v  7"
using tri_quad_le_degree[of g v]
by(auto simp:tame_def tame11b_def split:if_split_asm)


lemma filter_tame_succs:
assumes invP: "invariant P succs" and fin: "g. final g  succs g = []"
and ok_untame: "g. P g  ¬ ok g  final g  ¬ tame g"
and gg': "g [succs]→* g'"
shows "P g  final g'  tame g'  g [filter ok  succs]→* g'"
using gg'
proof (induct rule:RTranCl.induct)
  case refl show ?case by(rule RTranCl.refl)
next
  case (succs h h' h'')
  hence "P h'"  using invP by(unfold invariant_def) blast
  show ?case
  proof cases
    assume "ok h'"
    thus ?thesis using succs P h' by(fastforce intro:RTranCl.succs)
  next
    assume "¬ ok h'" note fin_tame = ok_untame[OF P h' ¬ ok h']
    have "h'' = h'" using fin_tame
      by(rule_tac RTranCl.cases[OF succs(2)])(auto simp:fin)
    hence False using fin_tame succs by fast
    thus ?case ..
  qed
qed


definition untame :: "(graph  bool)  bool" where
"untame P  g. final g  P g  ¬ tame g"


lemma filterout_untame_succs:
assumes invP: "invariant P f" and invPU: "invariant (λg. P g   U g) f"
and untame: "untame(λg. P g  U g)"
and new_untame: "g g'.  P g; g'  set(f g); g'  set(f' g)   U g'"
and gg': "g [f]→* g'"
shows "P g  final g'  tame g'  g [f']→* g'"
using gg'
proof (induct rule:RTranCl.induct)
  case refl show ?case by(rule RTranCl.refl)
next
  case (succs h h' h'')
  hence Ph': "P h'"  using invP by(unfold invariant_def) blast
  show ?case
  proof cases
    assume "h'  set(f' h)"
    thus ?thesis using succs Ph' by(blast intro:RTranCl.succs)
  next
    assume "h'  set(f' h)"
    with succs(4) succs(1) have "U h'" by (rule new_untame)
    hence False using Ph' RTranCl_inv[OF invPU] untame succs
      by (unfold untame_def) fast
    thus ?case ..
  qed
qed

end

Theory TameEnum

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section ‹Neglectable Final Graphs›

theory TameEnum
imports Generator
begin

definition is_tame :: "graph  bool" where
"is_tame g    tame10 g  tame11a g  tame12o g  is_tame13a g"

definition next_tame :: "nat  graph  graph list" ("next'_tame⇘_") where
"next_tamep  filter (λg. ¬ final g  is_tame g)  next_tame0p"

definition TameEnumP :: "nat  graph set" ("TameEnum⇘_") where
"TameEnump  {g. Seedp [next_tamep]→* g  final g}"

definition TameEnum :: "graph set" where
"TameEnum  p3. TameEnump"

end

Theory ScoreProps

(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section ‹Properties of Lower Bound Machinery›

theory ScoreProps
imports ListSum TameEnum PlaneProps TameProps
begin

lemma deleteAround_empty[simp]: "deleteAround g a [] = []"
by (simp add: deleteAround_def)

lemma deleteAroundCons:
  "deleteAround g a (p#ps) =
    (if fst p  {v. f  set (facesAt g a).
               (length (vertices f) = 4)  v  {f  a, f  (f  a)}
              (length (vertices f)  4)  (v = f  a)}
     then deleteAround g a ps
     else p#deleteAround g a ps)"
by (fastforce simp: nextV2 deleteAround_def)

lemma deleteAround_subset: "set (deleteAround g a ps)  set ps"
by (simp add: deleteAround_def)

lemma distinct_deleteAround: "distinct (map fst ps) 
    distinct (map fst (deleteAround g (fst (a, b)) ps))"
proof (induct ps)
  case Nil then show ?case by simp
next
  case (Cons p ps)
  then have "fst p  fst ` set ps" by simp
  moreover have "set (deleteAround g a ps)  set ps"
    by (rule deleteAround_subset)
  ultimately have "fst p  fst ` set (deleteAround g a ps)" by auto

  moreover from Cons have "distinct (map fst ps)" by simp
  then have "distinct (map fst (deleteAround g (fst (a, b)) ps))"
    by (rule Cons)
  ultimately show ?case by (simp add: deleteAroundCons)
qed


definition deleteAround' :: "graph  vertex  (vertex × nat) list 
    (vertex × nat) list" where
  "deleteAround' g v ps 
      let fs = facesAt g v;
      vs = (λf. let n1 = f  v;
                n2 = f  n1 in
                if length (vertices f) = 4 then [n1, n2] else [n1]);
      ws = concat (map vs fs) in
      removeKeyList ws ps"


lemma deleteAround_eq: "deleteAround g v ps = deleteAround' g v ps"
apply (auto simp add: deleteAround_def deleteAround'_def split: if_split_asm)
apply (unfold nextV2[THEN eq_reflection], simp)
done

lemma deleteAround_nextVertex:
  "f  set (facesAt g a) 
  (f  a, b)  set (deleteAround g a ps)"
by (auto simp add: deleteAround_eq deleteAround'_def removeKeyList_eq)

lemma deleteAround_nextVertex_nextVertex:
  "f  set (facesAt g a)  |vertices f| = 4 
  (f  (f  a), b)  set (deleteAround g a ps)"
by (auto simp add: deleteAround_eq deleteAround'_def removeKeyList_eq)


lemma deleteAround_prevVertex:
  "minGraphProps g  a : 𝒱 g  f  set (facesAt g a) 
  (f-1  a, b)  set (deleteAround g a ps)"
proof -
  assume a: "minGraphProps g" "a : 𝒱 g" "f  set (facesAt g a)"
  have "(f-1  a, a)   f" using a
    by(blast intro:prevVertex_in_edges minGraphProps)
  then obtain f' :: face where f': "f'  set(facesAt g a)"
    and e: "(a, f-1  a)   f'"
    using a by(blast dest:mgp_edge_face_ex)
  have "(f'  a, b)  set (deleteAround g a ps)" using f'
    by (auto simp add: deleteAround_eq deleteAround'_def removeKeyList_eq)
  moreover have "f'  a = f-1  a"
    using e by (simp add:edges_face_eq)
  ultimately show ?thesis by simp
qed


lemma deleteAround_separated:
assumes mgp: "minGraphProps g" and fin: "final g" and ag: "a : 𝒱 g" and 4: "|vertices f|  4"
and f: "f  set(facesAt g a)"
shows "𝒱 f  set [fst p. p  deleteAround g a ps]  {a}" (is "?A")
proof -
  note MGP = mgp ag f
  have af: "a  𝒱 f" using MGP by(blast intro:minGraphProps)
  have "2 < |vertices f|" using MGP by(blast intro:minGraphProps)
  with 4 have "|vertices f| = 3  |vertices f| = 4" by arith
  then show "?A"
  proof
    assume 3: "|vertices f| = 3"
    show "?A"
    proof (rule ccontr)
      assume "¬ ?A"
      then obtain b where b1: "b  a" "b  𝒱 f"
        "b  set (map fst (deleteAround g a ps))" by auto
      from MGP have d: "distinct (vertices f)"
        by(blast intro:minGraphProps)
      with af 3 have "𝒱 f = {a, f  a, f  (f  a)}"
          by (rule_tac vertices_triangle)
      also from d af 3 have
        "f  (f  a) = f-1  a"
        by (simp add: triangle_nextVertex_prevVertex)
      finally have
        "b  {f  a, f-1  a}"
        using b1 by simp
      with MGP have "b  set (map fst (deleteAround g a ps))"
      using deleteAround_nextVertex deleteAround_prevVertex by auto
      then show False by contradiction (rule b1)
    qed
  next
    assume 4: "|vertices f| = 4"
    show "?A"
    proof (rule ccontr)
      assume "¬ ?A"
      then obtain b where b1: "b  a" "b  𝒱 f"
        "b  set (map fst (deleteAround g a ps))" by auto
      from MGP have d: "distinct (vertices f)" by(blast intro:minGraphProps)
      with af 4 have "𝒱 f = {a, f  a, f  (f  a), f  (f  (f  a))}"
        by (rule_tac vertices_quad)
      also from d af 4 have "f  (f  (f  a)) = f-1  a"
        by (simp add: quad_nextVertex_prevVertex)
      finally have "b  {f  a, f  (f  a), f-1  a}"
      using b1 by simp
      with MGP 4 have "b  set (map fst (deleteAround g a ps))"
      using deleteAround_nextVertex deleteAround_prevVertex
           deleteAround_nextVertex_nextVertex by auto
      then show False by contradiction (rule b1)
    qed
  qed
qed
(*
deleteAround g y loescht nextVertex f a,
nextVertex f (nextVertex f a),
prevVertex f a wird mit nachbarflaeche geloescht.
*)

lemma [iff]: "separated g {}"
by (simp add: separated_def separated2_def separated3_def)

lemma separated_insert:
assumes mgp: "minGraphProps g" and a: "a  𝒱 g"
  and Vg: "V  𝒱 g"
  and ps: "separated g V"
  and s2: "(f. f  set (facesAt g a)  f  a  V)"
  and s3: "(f. f  set (facesAt g a) 
      |vertices f|  4  𝒱 f  V  {a})"
  shows "separated g (insert a V)"
proof (simp add: separated_def separated2_def separated3_def,
 intro conjI ballI impI)
  fix f assume f: "f  set (facesAt g a)"
  then show "f  a  a" by (rule mgp_facesAt_no_loop[OF mgp a])
  from f show "f  a  V" by (rule s2)
next
  fix f v assume v: "f  set (facesAt g v)" and vV: "v  V"
  have "v : 𝒱 g" using vV Vg by blast
  show "f  v  a"
  proof
    assume f: "f  v = a"
    then obtain f' where f': "f'  set(facesAt g a)" and v: "f'  a = v"
      using mgp_nextVertex_face_ex2[OF mgp v : 𝒱 g v] by blast
    have "f'  a  V" using v vV by simp
    with f' s2 show False by blast
  qed
  from ps v vV show "f  v  V"
    by (simp add: separated_def separated2_def)
next
  fix f assume f:  "f  set (facesAt g a)" "|vertices f|  4"
  then have "𝒱 f  V  {a}" by (rule s3)
  moreover from mgp a f have "a  𝒱 f" by(blast intro:minGraphProps)
  ultimately show "𝒱 f  insert a V = {a}" by auto
next
  fix v f
  assume a: "v  V" "f  set (facesAt g v)"
    "|vertices f|  4"
  with ps have v: "𝒱 f  V = {v}"
    by (simp add: separated_def separated3_def)
  have "v : 𝒱 g" using a Vg by blast
  show  "𝒱 f  insert a V = {v}"
  proof cases
    assume "a = v"
    with v mgp a show ?thesis by(blast intro:minGraphProps)
  next
    assume n: "a  v"
    have  "a  𝒱 f"
    proof
      assume a2: "a  𝒱 f"
      with mgp a v : 𝒱 g have "f   g" by(blast intro:minGraphProps)
      with mgp a2 have "f  set (facesAt g a)" by(blast intro:minGraphProps)
      with a have "𝒱 f  V  {a}" by (simp add: s3)
      with v have "a = v" by auto
      with n show False by auto
    qed
    with a  v show "𝒱 f  insert a V = {v}" by blast
  qed
qed


function ExcessNotAtRecList :: "(vertex, nat) table  graph  vertex list" where
  "ExcessNotAtRecList [] = (λg. [])"
  | "ExcessNotAtRecList ((x, y) # ps) = (λg.
      let l1 = ExcessNotAtRecList ps g;
      l2 = ExcessNotAtRecList (deleteAround g x ps) g in
      if ExcessNotAtRec ps g
        y + ExcessNotAtRec (deleteAround g x ps) g
      then x # l2 else l1)"
by pat_completeness auto
termination by (relation "measure size")
  (auto simp add: less_Suc_eq_le length_deleteAround)

lemma isTable_deleteAround:
  "isTable E vs ((a,b)#ps)  isTable E vs (deleteAround g a ps)"
by (rule isTable_subset, rule deleteAround_subset,
    rule isTable_Cons)

lemma ListSum_ExcessNotAtRecList:
 "isTable E vs ps  ExcessNotAtRec ps g
  = (p  ExcessNotAtRecList ps g E p)" (is "?T ps  ?P ps")
proof (induct ps rule: ExcessNotAtRecList.induct)
  case 1 show ?case by simp
next
  case (2 a b ps)
  from 2 have prem: "?T ((a,b)#ps)" by blast
  then have E: "b = E a" by (simp add: isTable_eq)
  from 2 have hyp1: "?T (deleteAround g a ps) 
   ?P (deleteAround g a ps)" by blast
  from 2 have hyp2:  "?T ps  ?P ps" by blast
  have H1: "?P (deleteAround g a ps)"
    by (rule hyp1, rule isTable_deleteAround) (rule prem)
  have H2: "?P ps" by (rule hyp2, rule isTable_Cons, rule prem)
  show "?P ((a,b)#ps)"
  proof cases
    assume
    "ExcessNotAtRec ps g
     b + ExcessNotAtRec (deleteAround g a ps) g"
    with H1 E show ?thesis
      by (simp add: max_def split: if_split_asm)
  next
    assume "¬ ExcessNotAtRec ps g
        b + ExcessNotAtRec (deleteAround g a ps) g"
    with H2 E show ?thesis
      by (simp add: max_def split: if_split_asm)
  qed
qed

lemma ExcessNotAtRecList_subset:
  "set (ExcessNotAtRecList ps g)  set [fst p. p  ps]" (is "?P ps")
proof (induct ps rule: ExcessNotAtRecList.induct)
  case 1 show ?case by simp
next
  case (2 a b ps)
  presume H1: "?P (deleteAround g a ps)"
  presume H2: "?P ps"
  show "?P ((a, b) # ps)"
  proof cases
    assume a: "ExcessNotAtRec ps g
       b + ExcessNotAtRec (deleteAround g a ps) g"
    have "set (deleteAround g a ps)  set ps"
      by (simp add: deleteAround_subset)
    then have
    "fst ` set (deleteAround g a ps)  insert a (fst ` set ps)"
      by blast
    with a H1 show ?thesis by (simp)
  next
    assume "¬ ExcessNotAtRec ps g
       b + ExcessNotAtRec (deleteAround g a ps) g"
    with H2 show ?thesis by (auto)
  qed
qed simp

lemma separated_ExcessNotAtRecList:
 "minGraphProps g  final g  isTable E (vertices g) ps 
  separated g (set (ExcessNotAtRecList ps g))"
proof -
  assume fin: "final g" and mgp: "minGraphProps g"
  show
   "isTable E (vertices g) ps  separated g (set (ExcessNotAtRecList ps g))"
   (is "?T ps  ?P ps")
  proof (induct rule: ExcessNotAtRec.induct)
    case 1 show ?case by simp
  next
    case (2 a b ps)
    from 2 have prem: "?T ((a,b)#ps)" by blast
    then have E: "b = E a" by (simp add: isTable_eq)
    have "a :𝒱 g" using prem by(auto simp: isTable_def)
    from 2 have hyp1: "?T (deleteAround g a ps) 
      ?P (deleteAround g a ps)" by blast
    from 2 have hyp2:  "?T ps  ?P ps" by blast
    have H1: "?P (deleteAround g a ps)"
      by (rule hyp1, rule isTable_deleteAround) (rule prem)
    have H2: "?P ps" by (rule hyp2, rule isTable_Cons) (rule prem)

    show "?P ((a,b)#ps)"
    proof cases
      assume c: "ExcessNotAtRec ps g
         b + ExcessNotAtRec (deleteAround g a ps) g"
      have "separated g
       (insert a (set (ExcessNotAtRecList (deleteAround g a ps) g)))"
      proof (rule separated_insert[OF mgp])
        from prem show "a  set (vertices g)" by (auto simp add: isTable_def)

        show "set (ExcessNotAtRecList (deleteAround g a ps) g)  𝒱 g"
        proof-
          have "set (ExcessNotAtRecList (deleteAround g a ps) g) 
                set (map fst (deleteAround g a ps))"
            by(rule ExcessNotAtRecList_subset[simplified concat_map_singleton])
          also have "  set (map fst ps)"
            using deleteAround_subset by fastforce
          finally show ?thesis using prem by(auto simp: isTable_def)
        qed
        from H1
        show pS: "separated g
            (set (ExcessNotAtRecList (deleteAround g a ps) g))"
          by simp

        fix f assume f: "f  set (facesAt g a)"
        then have
        "f  a  set [fst p. p  deleteAround g a ps]"
          by (auto simp add: facesAt_def deleteAround_eq deleteAround'_def
            removeKeyList_eq split: if_split_asm)
        moreover
        have "set (ExcessNotAtRecList (deleteAround g a ps) g)
           set [fst p. p  deleteAround g a ps]"
          by (rule ExcessNotAtRecList_subset)
        ultimately
        show "f  a
           set (ExcessNotAtRecList (deleteAround g a ps) g)"
          by auto
        assume "|vertices f|  4"
        from this f have "set (vertices f)
           set [fst p. p  deleteAround g a ps]  {a}"
          by (rule deleteAround_separated[OF mgp fin a : 𝒱 g])
        moreover
        have "set (ExcessNotAtRecList (deleteAround g a ps) g)
           set [fst p. p  deleteAround g a ps]"
           by (rule ExcessNotAtRecList_subset)
        ultimately
        show "set (vertices f)
            set (ExcessNotAtRecList (deleteAround g a ps) g)  {a}"
          by blast
      qed
      with H1 E c show ?thesis by (simp)
    next
      assume "¬ ExcessNotAtRec ps g
         b + ExcessNotAtRec (deleteAround g a ps) g"
      with H2 E show ?thesis by simp
    qed
  qed
qed

lemma isTable_ExcessTable:
  "isTable (λv. ExcessAt g v) vs (ExcessTable g vs)"
by (auto simp add: isTable_def ExcessTable_def ExcessAt_def)

lemma ExcessTable_subset:
  "set (map fst (ExcessTable g vs))  set vs"
by (induct vs) (auto simp add: ExcessTable_def)

lemma distinct_ExcessNotAtRecList:
  "distinct (map fst ps)  distinct (ExcessNotAtRecList ps g)"
    (is "?T ps  ?P ps")
proof (induct rule: ExcessNotAtRec.induct)
  case 1 show ?case by simp
next
  case (2 a b ps)
  from 2 have prem: "?T ((a,b)#ps)" by blast
  then have a: "a  set (map fst ps)" by simp
  from 2 have hyp1: "?T (deleteAround g a ps) 
    ?P (deleteAround g a ps)" by blast
  from 2 have hyp2:  "?T ps  ?P ps" by blast
  from 2 have "?T ps" by simp
  then have H1: "?P (deleteAround g a ps)"
   by (rule_tac hyp1) (rule distinct_deleteAround [simplified])
  from prem have H2: "?P ps"
    by (rule_tac hyp2) simp

  have "a  set (ExcessNotAtRecList (deleteAround g a ps) g)"(* auto ?? *)
  proof
    assume "a  set (ExcessNotAtRecList (deleteAround g a ps) g)"
    also have "set (ExcessNotAtRecList (deleteAround g a ps) g)
       set [fst p. p  deleteAround g a ps]"
     by (rule ExcessNotAtRecList_subset)
    also have "set (deleteAround g a ps)  set ps"
      by (rule deleteAround_subset)
    then have "set [fst p. p  deleteAround g a ps]
       set [fst p. p  ps]" by auto
    finally have "a  set (map fst ps)" by simp
    with a show False by contradiction
  qed
  with H1 H2 show "?P ((a,b)#ps)"
    by ( simp add: ExcessNotAtRecList_subset)
qed

(* alternative definition *)
primrec ExcessTable_cont ::
  "(vertex  nat)  vertex list  (vertex × nat) list"
where
  "ExcessTable_cont ExcessAtPG [] = []" |
  "ExcessTable_cont ExcessAtPG (v#vs) =
   (let vi = ExcessAtPG v in
     if 0 < vi
     then (v, vi)#ExcessTable_cont ExcessAtPG vs
     else ExcessTable_cont ExcessAtPG vs)"

definition ExcessTable' :: "graph  vertex list  (vertex × nat) list" where
  "ExcessTable' g  ExcessTable_cont (ExcessAt g)"



lemma distinct_ExcessTable_cont:
  "distinct vs 
  distinct (map fst (ExcessTable_cont (ExcessAt g) vs))"
proof (induct vs)
  case Nil then show ?case by (simp add: ExcessTable_def)
next
  case (Cons v vs)
  from Cons have v: "v  set vs" by simp
  from Cons have "distinct vs" by simp
  with Cons have IH:
    "distinct (map fst (ExcessTable_cont (ExcessAt g) vs))"
    by simp
  moreover have
    "v  fst ` set (ExcessTable_cont (ExcessAt g) vs)"
  proof
    assume "v  fst ` set (ExcessTable_cont (ExcessAt g) vs)"
    also have "fst ` set (ExcessTable_cont (ExcessAt g) vs)  set vs"
      by (induct vs) auto
    finally have " v  set vs" .
    with v show False by contradiction
  qed
  ultimately show ?case by (simp add: ExcessTable_def)
qed


lemma ExcessTable_cont_eq:
 "ExcessTable_cont E vs =
  [(v, E v). v  [vvs . 0 < E v]]"
by (induct vs) (simp_all)


lemma ExcessTable_eq: "ExcessTable = ExcessTable'"
proof (rule ext, rule ext)
  fix p g vs show "ExcessTable g vs = ExcessTable' g vs"
  by (simp add: ExcessTable_def ExcessTable'_def ExcessTable_cont_eq)
qed

lemma distinct_ExcessTable:
   "distinct vs  distinct [fst p. p  ExcessTable g vs]"
by (simp_all add: ExcessTable_eq ExcessTable'_def distinct_ExcessTable_cont)

lemma ExcessNotAt_eq:
  "minGraphProps g  final g 
  V. ExcessNotAt g None
      = (v  V ExcessAt g v)
    separated g (set V)  set V  set (vertices g)
    distinct V"
proof (intro exI conjI)
  assume mgp: "minGraphProps g" and fin: "final g"
  let ?ps = "ExcessTable g (vertices g)"
  let ?V = "ExcessNotAtRecList ?ps g"
  let ?vs = "vertices g"
  let ?E = "λv. ExcessAt g v"
  have t: "isTable ?E ?vs ?ps" by (rule isTable_ExcessTable)
  with this show "ExcessNotAt g None = (v  ?V ?E v)"
    by (simp add: ListSum_ExcessNotAtRecList ExcessNotAt_def)

  show "separated g (set ?V)"
    by(rule separated_ExcessNotAtRecList[OF mgp fin t])

  have "set (ExcessNotAtRecList ?ps g)  set (map fst ?ps)"
    by (rule ExcessNotAtRecList_subset[simplified concat_map_singleton])
  also have "  set (vertices g)" by (rule ExcessTable_subset)
  finally show "set ?V  set (vertices g)" .

  show "distinct ?V"
    by (simp add: distinct_ExcessNotAtRecList distinct_ExcessTable[simplified concat_map_singleton])
qed

lemma excess_eq:
  assumes 7: "t + q  7"
  shows "excessAtType t q 0 + t * 𝖽 3 + q * 𝖽 4 = 𝖻 t q"
proof -
  note simps = excessAtType_def squanderVertex_def squanderFace_def
    nat_minus_add_max squanderTarget_def
  from 7 have "q=0  q=1  q=2  q=3  q=4  q=5  q=6  q=7" by arith
  then show ?thesis
  proof (elim disjE)
    assume q: "q = 0" (* 16 subgoals *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 1" (* 29 subgoals *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 2" (* 16 subgoals *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 3" (* 16 subgoals *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 4" (* 6 subgoals *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 5" (* 1 subgoal *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 6" (* 1 subgoal *)
    with 7 show ?thesis by (simp add: simps)
  next
    assume q: "q = 7" (* 1 subgoal *)
    with 7 show ?thesis by (simp add: simps)
  qed
qed

lemma excess_eq1:
  " inv g; final g; tame g; except g v = 0; v  set(vertices g)  
   ExcessAt g v + (tri g v) * 𝖽 3 + (quad g v) * 𝖽  4
   = 𝖻 (tri g v) (quad g v)"
apply(subgoal_tac "finalVertex g v")
apply(simp add: ExcessAt_def excess_eq faceCountMax_bound)
apply(auto simp:finalVertex_def plane_final_facesAt)
done

text ‹separating›

definition separating :: "'a set  ('a  'b set)  bool" where
  "separating V F  
   (v1  V. v2  V. v1  v2   F v1  F v2 = {})"


lemma separating_insert1: 
  "separating (insert a V) F  separating V F"
  by (simp add: separating_def)

lemma separating_insert2:
  "separating (insert a V) F  a  V   v  V  
  F a  F v = {}"
  by (auto simp add: separating_def)

lemma sum_disj_Union: 
 "finite V  
  (f. finite (F f))  
  separating V F  
  (vV. f(F v). (w f::nat)) = (f(vV. F v). w f)"
proof (induct  rule: finite_induct)
  case empty then show ?case by simp
next
  case (insert a V) 
  then have s: "separating (insert a V) F" by simp
  then have "separating V F" by (rule_tac separating_insert1)
  with insert
  have IH: "(vV. f(F v). w f) = (f(vV. F v). w f)" 
    by simp

  moreover have fin: "finite V" "a  V" "f. finite (F f)" by fact+

  moreover from s have "v. a  V  v  V  F a  F v = {}"
   by (simp add: separating_insert2)
  with fin have "(F a)  (vV. F v) = {}" by auto 

  ultimately show ?case by (simp add: sum.union_disjoint)
qed

lemma separated_separating:
assumes Vg: "set V  𝒱 g"
and pS: "separated g (set V)"
and noex: "fP. |vertices f|  4"
shows "separating (set V) (λv. set (facesAt g v)  P)"
proof -
  from pS have i: "vset V. fset (facesAt g v).
    |vertices f|  4  set (vertices f)  set V = {v}"
    by (simp add: separated_def separated3_def)
  show "separating (set V) (λv. set (facesAt g v)  P)"
  proof (simp add: separating_def, intro ballI impI)
    fix v1 v2 assume v: "v1  set V" "v2  set V" "v1  v2"
    hence "v1 : 𝒱 g" using Vg by blast
    show "(set (facesAt g v1)  P)  (set (facesAt g v2)  P) = {}" (is "?P")
    proof (rule ccontr)
      assume "¬ ?P"
      then obtain f where f1: "f  set (facesAt g v1)"
        and f2: "f  set (facesAt g v2)" and "f : P" by auto
      with noex have l: "|vertices f|  4" by blast
      from v f1 l i have "set (vertices f)  set V = {v1}" by simp
      also from v f2 l i
      have "set (vertices f)  set V = {v2}" by simp
      finally have "v1 = v2" by auto
      then show False by contradiction (rule v)
    qed
  qed
qed

lemma ListSum_V_F_eq_ListSum_F:
assumes pl: "inv g"
and pS: "separated g (set V)" and dist: "distinct V"
and V_subset: "set V  set (vertices g)"
and noex: "f  Collect P. |vertices f|  4"
shows "(v  Vf  filter P (facesAt g v) (w::face  nat) f)
       = (f  [ffaces g . v  set V. f  set (facesAt g v)  Collect P] w f)"
proof -
  have s: "separating (set V) (λv. set (facesAt g v)  Collect P)"
    by (rule separated_separating[OF V_subset pS noex])
  moreover note dist
  moreover from pl V_subset
  have "v. v  set V  distinct (facesAt g v)"
    by(blast intro:mgp_dist_facesAt[OF inv_mgp])
  hence v: "v. v  set V  distinct (filter P (facesAt g v))"
    by simp
  moreover
  have "distinct [ffaces g . v  set V. f  set (facesAt g v)  Collect P]"
    by (intro distinct_filter minGraphProps11'[OF inv_mgp[OF pl]])
  moreover from pl have "{x. x   g  (v  set V. x  set (facesAt g v)  P x)} =
      (vset V. set (facesAt g v)  Collect P)" using V_subset
    by (blast intro:minGraphProps inv_mgp)
  moreover from v have "(vset V. ListSum (filter P (facesAt g v)) w) = (vset V. sum w (set(facesAt g v)  Collect P))"
    by (auto simp add: ListSum_conv_sum Int_def)
  ultimately show ?thesis
    by (simp add: ListSum_conv_sum sum_disj_Union)
qed

lemma separated_disj_Union2:
assumes pl: "inv g" and fin: "final g" and ne: "noExceptionals g (set V)"
and pS: "separated g (set V)" and dist: "distinct V"
and V_subset: "set V  set (vertices g)"
shows "(v  Vf  facesAt g v (w::face  nat) f)
       = (f  [ffaces g . v  set V. f  set (facesAt g v)] w f)"
proof -
  let ?P = "λf. |vertices f|  4"
  have "v  set V. f  set (facesAt g v). |vertices f|  4"
    using V_subset ne
    by (auto simp: noExceptionals_def
      intro: minGraphProps5[OF inv_mgp[OF pl]] not_exceptional[OF pl fin])
  thus ?thesis
    using ListSum_V_F_eq_ListSum_F[where P = ?P, OF pl pS dist V_subset]
    by (simp add: Int_def cong: conj_cong)
qed

lemma squanderFace_distr2: "inv g  final g  noExceptionals g (set V) 
  separated g (set V)  distinct V  set V  set (vertices g) 
     (f  [ffaces g. v  set V. f  set (facesAt g v)]
         𝖽 |vertices f| )
   = (v  V ((tri g v) * 𝖽 3
         + (quad g v) * 𝖽 4))"
proof -
  assume pl: "inv g"
  assume fin: "final g"
  assume ne: "noExceptionals g (set V)"
  assume "separated g (set V)"  "distinct V" and V_subset: "set V  set (vertices g)"
  with pl ne fin have
    "(f  [ffaces g. vset V. fset (facesAt g v)] 𝖽 |vertices f| )
   = (v  Vf  facesAt g v 𝖽 |vertices f| )"
    by (simp add: separated_disj_Union2)
  also have "v. v  set V 
    (f  facesAt g v 𝖽 |vertices f| )
  = (tri g v) * 𝖽 3 + (quad g v) * 𝖽 4"
  proof -
    fix v assume v1: "v  set V"
    with V_subset have v: "v  set (vertices g)" by auto

    with ne have d:
      "f. f  set (facesAt g v) 
      |vertices f| = 3  |vertices f| = 4"
    proof -
      fix f assume f: "f  set (facesAt g v)"
      then have ff: "f  set (faces g)" by (rule minGraphProps5[OF inv_mgp[OF pl] v])
      with ne f v1 pl fin v have "|vertices f|  4"
        by (auto simp add: noExceptionals_def not_exceptional)
      moreover from pl ff have "3  |vertices f|" by(rule planeN4)
      ultimately show "?thesis f" by arith
    qed

    from d pl v have
      "(f  facesAt g v 𝖽 |vertices f| )
    = (f[f  facesAt g v. |vertices f| = 3] 𝖽 |vertices f| )
    + (f[f  facesAt g v. |vertices f| = 4] 𝖽 |vertices f| )"
      apply (rule_tac ListSum_disj_union)
      apply (rule distinct_filter) apply simp
      apply (rule distinct_filter) apply simp
      apply simp
      apply force
      apply force
      done
    also have " = tri g v * 𝖽 3 + quad g v * 𝖽 4"
    proof -
      from pl fin v have "A.[f  facesAt g v. final f  A f]
        = [f  facesAt g v. A f]"
        by (rule_tac filter_eqI) (auto simp:plane_final_facesAt)
      with fin show ?thesis  by (auto simp add: tri_def quad_def)
    qed
    finally show "(f  facesAt g v 𝖽 |vertices f| ) = tri g v * 𝖽 3 + quad g v * 𝖽 4" .
  qed
  then have "(v  Vf  facesAt g v 𝖽 |vertices f| ) =
         (v  V (tri g v * 𝖽 3 + quad g v * 𝖽 4))"
     by (rule ListSum_eq)
  finally show ?thesis .
qed



lemma separated_subset: (* separated *)
   "V1  V2  separated g V2  separated g V1"
proof (simp add:  separated_def separated3_def separated2_def,
  elim conjE, intro allI impI ballI conjI)
  fix v f
  assume a: "v  V1" "V1  V2" "f  set (facesAt g v)"
    "|vertices f|  4"
    "vV2. fset (facesAt g v). |vertices f|  4 
      set (vertices f)  V2 = {v}"
  then show "set (vertices f)  V1 = {v}" by auto
next
  fix v f
  assume a: "v  V1" "V1  V2" "f  set (facesAt g v)"
    "vV2. fset (facesAt g v). f  v  V2"
  then have "v  V2" by auto
  with a have "f  v  V2" by auto
  with a show "f  v  V1" by auto
qed

end

Theory LowerBound

(*  Author:  Gertrud Bauer  *)

section ‹Correctness of Lower Bound for Final Graphs›

theory LowerBound
imports PlaneProps ScoreProps
begin

(*<*)
lemma trans1:
 "(l::nat) = a1 + a2 + (a3 + a4)  a1 + a3 = r  l = r + a2 + a4"
by simp

lemma trans2: "(l::nat) =  a1 + a2 + a3    a1  r  l  r + a2 + a3"
by simp

lemma trans3:
 "(l::nat)   a1 + a2 + (a3 + a4)  a2 + a3  r  l  a1 + r + a4"
by simp

lemma trans4: "(l::nat)  a1 + a2 + a3  a3  r  l  a1 + a2 + r"
by simp

lemma trans5: "(l::nat)  a1 + a2 + a3  a2 + a3 = r  l  a1 + r"
by simp

lemma trans6: "(a::nat) = b1 + (b2 + b3) + b4  b3 = 0 
            a = b1 + b2 + b4" by (simp add: ac_simps)
(*>*)

(* FIXME in Tame: admissibility should be expressed via sum!
   → convert a lot of listsum to sum
*)

theorem total_weight_lowerbound:
 "inv g  final g  tame g  admissible w g 
 (f  faces g w f) < squanderTarget 
 squanderLowerBound g  (f  faces g w f)"
proof -
  assume final: "final g" and tame: "tame g" and pl: "inv g"
  assume admissible: "admissible w g"
  assume w: "(f  faces g w f) < squanderTarget"
(*<*)
  from admissible have admissible1:
   "f. f  set (faces g)  𝖽 |vertices f|  w f"
    by (simp add: admissible_def admissible1_def)
(*>*) (* *)

  have "squanderLowerBound g
     = ExcessNotAt g None + faceSquanderLowerBound g"
    by (simp add: squanderLowerBound_def)

  txt ‹We expand the definition of faceSquanderLowerBound›.›

  also have "faceSquanderLowerBound g = (f  faces g 𝖽 |vertices f| )" (*<*)
    by (simp add: faceSquanderLowerBound_def final) (*>*)

  txt ‹We expand the definition of ExcessNotAt›.›
  also from ExcessNotAt_eq[OF pl[THEN inv_mgp] final] obtain V
    where eq: "ExcessNotAt g None = (v  V ExcessAt g v)"
    and pS:  "separated g (set V)"
    and V_subset: "set V  set(vertices g)"
    and V_distinct: "distinct V" (*<*)
    by (blast) note eq

  txt ‹We partition V in two disjoint subsets $V1, V2$,
  where $V2$ contains all exceptional vertices, $V1$ all
  not exceptional vertices.›

  also
  define V1 where "V1 = [v  V. except g v = 0]"
  define V2 where "V2 = [v  V. except g v  0]"  (*<*)
  have s: "set V1  set V" by (auto simp add: V1_def)
  with pS obtain pSV1: "separated g (set V1)"
    by (auto dest: separated_subset)
  from V_distinct obtain V1_distinct: "distinct V1"
    by (unfold V1_def) (auto dest: distinct_filter)
  obtain noExV1: "noExceptionals g (set V1)"
    by (auto simp add: V1_def noExceptionals_def
      exceptionalVertex_def)
(*>*) (* *)

  have V_subset_simp: "v. v: set V  v : 𝒱 g"
    using V_subset by fast

  have "(v  V ExcessAt g v)
    = (v  V1 ExcessAt g v) + (v  V2 ExcessAt g v)" (*<*)
     by (simp only: V1_def V2_def ListSum_compl) (*>*)

  txt ‹We partition V2› in two disjoint subsets,
  $V4$ contains all exceptional vertices of degree $\neq 5$
  $V3$ contains all exceptional vertices of degree $5$.
›

  also
  define V4 where "V4 = [v  V2. vertextype g v  (5,0,1)]"
  define V3 where "V3 = [v  V2. vertextype g v = (5,0,1)]"

(*<*)
  with pS V2_def have V3: "separated g (set V3)"
    by (rule_tac separated_subset) auto
  have "distinct V3" by(simp add:V3_def V2_def ‹distinct V)
(*
  with V3_def V2_def obtain V3: "separated g (set V3)"
    by (simp add: vertextype_def separated_def preSeparated_def separated1_def
      separated4_def)
*)
  from V_subset obtain V3_subset: "set V3  𝒱 g"
    by (auto simp add: V3_def V2_def)
(*>*)

  have "(v  V2 ExcessAt g v)
    = (v  V3 ExcessAt g v) + (v  V4 ExcessAt g v)" (*<*)
    by (simp add: V4_def V3_def ListSum_compl) (*>*) (* *)

  txt ‹We partition  faces g› in two disjoint subsets:
  $F1$ contains all faces that contain a vertex of $V1$,
  $F2$ the remaining faces.›

  also
  define F1 where "F1 = [f  faces g .  v  set V1. f  set (facesAt g v)]"
  define F2 where "F2 = [f  faces g . ¬( v  set V1. f  set (facesAt g v))]"

  have "(f  faces g 𝖽 |vertices f| )
      = (f  F1 𝖽 |vertices f| ) + ( f  F2 𝖽 |vertices f| )" (*<*)
    by (simp only: ListSum_compl F1_def F2_def) (*>*) (* *)

  txt ‹We split up F2› in two disjoint subsets:›

  also
  define F3 where "F3 = [fF2. v  set V3. f  set (facesAt g v)]"
  define F4 where "F4 = [fF2. ¬ (v  set V3. f  set (facesAt g v))]"

  have F3: "F3 = [ffaces g . v  set V3. f  set (facesAt g v)]"
  proof(simp add: F3_def F2_def, intro filter_eqI iffI conjI)
     fix f assume "f  set (faces g)"
     with final have fin: "final f" by (rule finalGraph_face)
     assume "v3set V3. f  set (facesAt g v3)"
     then obtain v3 where v3: "v3  set V3" "f  set (facesAt g v3)"
       by auto
     show "(v1set V1. f  set (facesAt g v1))"
     proof (intro ballI notI)
       fix v1 assume v1: "v1  set V1"
       with v3 have "v1  v3"
         by (auto simp add: V3_def V2_def V1_def)

       moreover assume f: "f  set (facesAt g v1)"
       with v1 fin have c: "|vertices f|  4"
         by (auto simp add: V1_def except_def)

       from v1 have "v1  set V" by (simp add: V1_def)
       with f pS c have "set (vertices f)  set V = {v1}"
         by (simp add: separated_def separated3_def)

       moreover from v3 have "v3  set V"
         by (simp add: V3_def V2_def)
       with v3 pS c have "set (vertices f)  set V = {v3}"
         by (simp add: separated_def separated3_def)
       ultimately show False by auto
    qed
  qed simp

  have "(fF2 𝖽 |vertices f| )
   = (fF3 𝖽 |vertices f| ) + (fF4 𝖽 |vertices f| )" (*<*)
    by (simp only: F3_def F4_def ListSum_compl) (*>*) (* *)

  text_raw ‹\newpage›
  txt ‹($E_1$) From the definition of ExcessAt› we have›

  also have "(v  V1 ExcessAt g v) + ( f  F1 𝖽 |vertices f| )
      = (v  V1 𝖻 (tri g v) (quad g v))"
  proof -
    from noExV1 V_subset have "( f  F1 𝖽 |vertices f| )
      = (v  V1 (tri g v *  𝖽 3 + quad g v * 𝖽 4))"
    apply (unfold F1_def)
    apply (rule_tac squanderFace_distr2)
    apply (rule pl)
    apply (rule final)
    apply (rule noExV1)
    apply (rule pSV1)
    apply (rule V1_distinct)
    apply (unfold V1_def)
    apply auto
    done

    also have "(v  V1 ExcessAt g v)
      + (v  V1 (tri g v * 𝖽 3 + quad g v * 𝖽 4))
      = (v  V1 (ExcessAt g v
      + tri g v * 𝖽 3 + quad g v * 𝖽 4))" (*<*)
      by (simp add: ListSum_add ac_simps) (*>*) (* FIXME  also takes too long *)
    also from pl final tame have " = (v  V1 𝖻 (tri g v) (quad g v))"
      by (rule_tac ListSum_eq)
         (fastforce simp add: V1_def V_subset[THEN subsetD] intro: excess_eq1)
    finally show ?thesis .
  qed

  txt ‹($E_2$)  For all exceptional vertices of degree $5$
  excess› returns a (tri g v)›.›

  also (trans1)
    from pl final V_subset have
    "(v  V3 ExcessAt g v) = (v  V3 𝖺)" (*<*)
     apply (rule_tac ListSum_eq)
     apply (simp add: V3_def V2_def excessAtType_def ExcessAt_def degree_eq vertextype_def)
     by(blast intro: finalVertexI)
(*     apply force by(blast intro: finalVertexI)*) (*>*) (* *)

  txt ‹($E_3$) For all exceptional vertices of degree $\neq 5$
  ExcessAt› returns 0.›

  also from pl final tame have "(v  V4 ExcessAt g v) = (v  V4 0)" (*<*)
    by (rule_tac ListSum_eq)
       (auto simp: V2_def V4_def excessAtType_def ExcessAt_def degree_eq V_subset_simp tame_def tame12o_def) (*>*) (* *)

  also have " = 0" (*<*) by simp   (*>*) (* *)

  txt ‹($A_1$) We use property admissible2.›

  also(trans6) have
  "(v  V1 𝖻 (tri g v) (quad g v))  (v  V1f  facesAt g v w f)"

  proof (rule_tac ListSum_le)
    fix v assume "v  set V1"
    with V1_def V_subset have "v  set (vertices g)" (*<*)  by auto (*>*) (* *)
    with admissible show "𝖻 (tri g v) (quad g v)  (f  facesAt g v w f)"
      using v  set V1 by (auto simp add:admissible_def admissible2_def V1_def)
  qed

  also(trans2) from pSV1 V1_distinct V_subset have " = (f  F1 w f)"
    apply (unfold F1_def)
    apply (rule ScoreProps.separated_disj_Union2)
    apply (rule pl)
    apply (rule final)
    apply (rule noExV1)
    apply (rule pSV1)
    apply (rule V1_distinct)
    apply (unfold V1_def)
    apply auto
    done

  txt ‹($A_2$) We use property admissible4.›

  also have "(vV3 𝖺) + (fF3 𝖽 |vertices f| )  (f  F3 w f)" (*<*)
  proof-
    define T where "T = [fF3. triangle f]"
    define E where "E = [fF3. ¬ triangle f]"
    have "(fF3 𝖽 |vertices f| ) =
      (fT 𝖽 |vertices f| ) + (fE 𝖽 |vertices f| )"
      by(simp only: T_def E_def ListSum_compl2)
    also have "(fT 𝖽 |vertices f| ) =
          (f  [ffaces g . v  set V3. f  set (facesAt g v)  Collect triangle] 𝖽 |vertices f| )"
      by(rule listsum_cong[OF _ HOL.refl])
        (simp add:T_def F3 Int_def)
    also have " = (v  V3f  filter triangle (facesAt g v) 𝖽 |vertices f| )"
      by(rule ListSum_V_F_eq_ListSum_F[symmetric, OF ‹inv g V3 ‹distinct V3 ‹set V3  𝒱 g])
        (simp add:Ball_def)
    also have " = 0" by (simp add: squanderFace_def)
    finally have "(vV3 𝖺) + (fF3 𝖽 |vertices f| ) =
      (vV3 𝖺) + (fE 𝖽 |vertices f| )" by simp
    also have "(fE 𝖽 |vertices f| )  (fE w f )"
      using ‹admissible w g
      by(rule_tac ListSum_le)
        (simp add: admissible_def admissible1_def E_def F3_def F2_def)
    also have "(vV3 𝖺)  (vV3ffilter triangle (facesAt g v) w(f))"
      using ‹admissible w g
      by(rule_tac ListSum_le)
        (simp add: admissible_def admissible3_def V3_def V2_def V_subset_simp)
    also have " = (f  [ffaces g . v  set V3. f  set (facesAt g v)  Collect triangle] w f)"
      by(rule ListSum_V_F_eq_ListSum_F[OF ‹inv g V3 ‹distinct V3 ‹set V3  𝒱 g])
        (simp add:Ball_def)
    also have " = (fT w f)"
      by(simp add: T_def F3 Int_def)
    also have "ListSum T w + ListSum E w = ListSum F3 w"
      by(simp add: T_def E_def ListSum_compl2)
    finally show ?thesis by simp
  qed

  text_raw ‹\newpage›
  txt ‹($A_3$) We use property admissible1.›

  also(trans3) have "( f  F4 𝖽 |vertices f| )  (f  F4 w f)"
  proof (rule ListSum_le)
    fix f assume "f  set F4"
    then have f: "f  set (faces g)" (*<*) by (simp add: F4_def F2_def)(*>*) (* *)
    with admissible1 f show "𝖽 |vertices f|  w f" by (simp)
  qed

  txt ‹We reunite $F3$ and $F4$.›

  also(trans4) have "( f  F3 w f) + ( f  F4 w f) = ( f  F2 w f)" (*<*)
    by (simp only: F3_def F4_def ListSum_compl) (*>*) (* *)

  txt ‹We reunite $F1$ and $F2$.›

  also(trans5) have "( f  F1 w f) + ( f  F2 w f) = (f  faces g w f)" (*<*)
    by (simp only: F1_def F2_def ListSum_compl) (*>*) (* *)

  finally show "squanderLowerBound g  (f  faces g w f)" .
qed

end

Theory GeneratorProps

(*  Author:  Tobias Nipkow  *)

section "Properties of Tame Graph Enumeration (1)"

theory GeneratorProps
imports Plane1Props Generator TameProps LowerBound
begin

lemma genPolyTame_spec:
 "generatePolygonTame n v f g = [g'  generatePolygon n v f g . ¬ notame g']"
by(simp add:generatePolygonTame_def generatePolygon_def enum_enumerator)

lemma genPolyTame_subset_genPoly:
 "g'  set(generatePolygonTame i v f g) 
  g'  set(generatePolygon i v f g)"
by(auto simp add:generatePolygon_def generatePolygonTame_def enum_enumerator)


lemma next_tame0_subset_plane:
 "set(next_tame0 p g)  set(next_plane p g)"
by(auto simp add:next_tame0_def next_plane_def polysizes_def
           elim!:genPolyTame_subset_genPoly simp del:upt_Suc)


lemma genPoly_new_face:
 "g'  set (generatePolygon n v f g); minGraphProps g; f  set (nonFinals g);
   v  𝒱 f; n  3  
  f  set(finals g') - set(finals g). |vertices f| = n"
apply(auto simp add:generatePolygon_def image_def)
apply(rename_tac "is")
apply(frule enumerator_length2)
 apply arith
apply(frule (4) pre_subdivFace_indexToVertexList)
 apply(arith)
apply(subgoal_tac "indexToVertexList f v is  []")
 prefer 2 apply(subst length_0_conv[symmetric]) apply simp
apply(simp add: subdivFace_subdivFace'_eq)
apply(clarsimp simp:neq_Nil_conv)
apply(rename_tac "ovs")
apply(subgoal_tac "|indexToVertexList f v is| = |ovs| + 1")
 prefer 2 apply(simp)
apply(drule (1) pre_subdivFace_pre_subdivFace')
apply(drule (1) final_subdivFace')
  apply(simp add:nonFinals_def)
 apply(simp add:pre_subdivFace'_def)
apply (simp (no_asm_use))
apply(simp)
apply blast
done


(* Could prove = instead of ≥, but who needs it? *)
lemma genPoly_incr_facesquander_lb:
assumes "g'  set (generatePolygon n v f g)" "inv g"
        "f  set(nonFinals g)" "v  𝒱 f" "3  n"
shows "faceSquanderLowerBound g'  faceSquanderLowerBound g + 𝖽 n"
proof -
  from genPoly_new_face[OF assms(1) inv_mgp[OF assms(2)] assms(3-5)] obtain f
    where f: "f  set (finals g') - set(finals g)"
    and size: "|vertices f| = n" by auto
  have g': "g'  set(next_plane0 (n - 3) g)" using assms(5)
    by(rule_tac in_next_plane0I[OF assms(1,3-5)]) simp
  note dist = minGraphProps11'[OF inv_mgp[OF assms(2)]]
  note inv' = invariantE[OF inv_inv_next_plane0, OF g' assms(2)]
  note dist' = minGraphProps11'[OF inv_mgp[OF inv']]
  note subset = next_plane0_finals_subset[OF g']
  have "faceSquanderLowerBound g' 
        faceSquanderLowerBound g + 𝖽 |vertices f|"
  proof(unfold faceSquanderLowerBound_def)
    have "(ffinals g 𝖽 |vertices f| ) + 𝖽 |vertices f| =
          (fset(finals g). 𝖽 |vertices f| ) + 𝖽 |vertices f|"
      using dist by(simp add:finals_def ListSum_conv_sum)
    also have " = (fset(finals g)  {f}. 𝖽 |vertices f| )"
      using f by simp
    also have "  (fset(finals g'). 𝖽 |vertices f| )"
      using f subset by(fastforce intro!: sum_mono2)
    also have " = (ffinals g' 𝖽 |vertices f| )"
      using dist' by(simp add:finals_def ListSum_conv_sum)
    finally show "(ffinals g 𝖽 |vertices f| ) + 𝖽 |vertices f|
           (ffinals g' 𝖽 |vertices f| )" .
  qed
  with size show ?thesis by blast
qed


definition close :: "graph  vertex  vertex  bool" where
"close g u v 
 f  set(facesAt g u). if |vertices f| = 4 then v = f  u  v = f  (f  u)
                        else v = f  u"

(* FIXME This should be the def of delAround *)
lemma delAround_def: "deleteAround g u ps = [p  ps. ¬ close g u (fst p)]"
by (induct ps) (auto simp: deleteAroundCons close_def)


lemma close_sym: assumes mgp: "minGraphProps g" and ug: "u : 𝒱 g" and cl: "close g u v"
shows "close g v u"
proof -
  obtain f where f: "f  set(facesAt g u)" and
    "if": "if |vertices f| = 4 then v = f  u  v = f  (f  u) else v = f  u"
    using cl by (unfold close_def) blast
  note uf = minGraphProps6[OF mgp ug f]
  note distf = minGraphProps3[OF mgp minGraphProps5[OF mgp ug f]]
  show ?thesis
  proof cases
    assume 4: "|vertices f| = 4"
    hence "v = f  u  v = f  (f  u)" using "if" by simp
    thus ?thesis
    proof
      assume "v = f  u"
      then obtain f' where "f'  set(facesAt g v)" "f'  v = u"
        using mgp_nextVertex_face_ex2[OF mgp ug f] by blast
      thus ?thesis by(auto simp:close_def)
    next
      assume v: "v = f  (f  u)"
      hence "f  (f  v) = u" using quad_next4_id[OF 4 distf uf] by simp
      moreover have "f  set(facesAt g v)" using v uf
        by(simp add: minGraphProps7[OF mgp minGraphProps5[OF mgp ug f]])
      ultimately show ?thesis using 4 by(auto simp:close_def)
    qed
  next
    assume "|vertices f|  4"
    hence "v = f  u" using "if" by simp
    then obtain f' where "f'  set(facesAt g v)" "f'  v = u"
      using mgp_nextVertex_face_ex2[OF mgp ug f] by blast
    thus ?thesis by(auto simp:close_def)
  qed
qed


lemma sep_conv:
assumes mgp: "minGraphProps g" and "V  𝒱 g"
shows "separated g V = (uV.vV. u  v  ¬ close g u v)" (is "?P = ?Q")
proof
  assume sep: ?P
  show ?Q
  proof(clarify)
    fix u v assume uv: "u  V" "v  V" "u  v" and cl: "close g u v"
    from cl obtain f where f: "f  set(facesAt g u)" and
      "if": "if |vertices f| = 4 then (v = f  u)  (v = f  (f  u))
                               else (v = f  u)"
      by (unfold close_def) blast
    have "u : 𝒱 g" using u : V V  𝒱 g by blast
    note uf = minGraphProps6[OF mgp u : 𝒱 g f]
    show False
    proof cases
      assume 4: "|vertices f| = 4"
      hence "v = f  u  v = f  (f  u)" using "if" by simp
      thus False
      proof
        assume "v = f  u"
        thus False using sep f uv
          by(simp add:separated_def separated2_def separated3_def)
      next
        assume "v = f  (f  u)"
        moreover hence "v  𝒱 f" using u  𝒱 f by simp
        moreover have "|vertices f|  4" using 4 by arith
        ultimately show False using sep f uv u  𝒱 f
          apply(unfold separated_def separated2_def separated3_def)
(* why does blast get stuck? *)
          apply(subgoal_tac "f  (f  u)  𝒱 f  V")
          prefer 2 apply blast
          by simp
      qed
    next
      assume 4: "|vertices f|  4"
      hence "v = f  u" using "if" by simp
      thus False using sep f uv
        by(simp add:separated_def separated2_def separated3_def)
    qed
  qed
next
  assume not_cl: ?Q
  show ?P
  proof(simp add:separated_def, rule conjI)
    show "separated2 g V"
    proof (clarsimp simp:separated2_def)
      fix v f assume a: "v  V" "f  set (facesAt g v)" "f  v  V"
      have "v : 𝒱 g" using a(1) V  𝒱 g by blast
      show False using a not_cl mgp_facesAt_no_loop[OF mgp v : 𝒱 g a(2)]
        by(fastforce simp: close_def split:if_split_asm)
    qed
    show "separated3 g V"
    proof (clarsimp simp:separated3_def)
      fix v f
      assume "v  V" and f: "f  set (facesAt g v)" and len: "|vertices f|  4"
      have vg: "v : 𝒱 g" using v : V V  𝒱 g by blast
      note distf = minGraphProps3[OF mgp minGraphProps5[OF mgp vg f]]
      note vf = minGraphProps6[OF mgp vg f]
      { fix u assume "u  𝒱 f" and "u  V"
        have "u = v"
        proof cases
          assume 3: "|vertices f| = 3"
          hence "𝒱 f = {v, f  v, f  (f  v)}"
            using vertices_triangle[OF _ vf distf] by simp
          moreover
          { assume "u = f  v"
            hence "u = v"
              using not_cl f u  V v  V 3
              by(force simp:close_def split:if_split_asm)
          }
          moreover
          { assume "u = f  (f  v)"
            hence fu: "f  u = v"
              by(simp add: tri_next3_id[OF 3 distf v  𝒱 f])
            hence "(u,v)   f" using nextVertex_in_edges[OF u  𝒱 f]
              by(simp add:fu)
            then obtain f' where "f'  set(facesAt g v)" "(v,u)    f'"
              using mgp_edge_face_ex[OF mgp vg f] by blast
            hence "u = v" using not_cl u  V v  V 3
              by(force simp:close_def edges_face_eq split:if_split_asm)
          }
          ultimately show "u=v" using u  𝒱 f by blast
        next
          assume 3: "|vertices f|  3"
          hence 4: "|vertices f| = 4"
            using len mgp_vertices3[OF mgp minGraphProps5[OF mgp vg f]] by arith
          hence "𝒱 f = {v, f  v, f  (f  v), f  (f  (f  v))}"
            using vertices_quad[OF _ vf distf] by simp
          moreover
          { assume "u = f  v"
            hence "u = v"
              using not_cl f u  V v  V 4
              by(force simp:close_def split:if_split_asm)
          }
          moreover
          { assume "u = f  (f  v)"
            hence "u = v"
              using not_cl f u  V v  V 4
              by(force simp:close_def split:if_split_asm)
          }
          moreover
          { assume "u = f  (f  (f  v))"
            hence fu: "f  u = v"
              by(simp add: quad_next4_id[OF 4 distf v  𝒱 f])
            hence "(u,v)   f" using nextVertex_in_edges[OF u  𝒱 f]
              by(simp add:fu)
            then obtain f' where "f'  set(facesAt g v)" "(v,u)    f'"
              using mgp_edge_face_ex[OF mgp vg f] by blast
            hence "u = v" using not_cl u  V v  V 4
              by(force simp:close_def edges_face_eq split:if_split_asm)
          }
          ultimately show "u=v" using u  𝒱 f by blast
        qed
      }
      thus "𝒱 f  V = {v}" using v  V vf by blast
    qed
  qed
qed

lemma sep_ne: "P  M. separated g (fst ` P)"
by(unfold separated_def separated2_def separated3_def) blast

lemma ExcessNotAtRec_conv_Max:
assumes mgp: "minGraphProps g"
shows "set(map fst ps)  𝒱 g  distinct(map fst ps) 
  ExcessNotAtRec ps g =
  Max{ pP. snd p |P. P  set ps  separated g (fst ` P)}"
  (is "_  _  _ = Max(?M ps)" is "_  _  _ = Max{_ |P. ?S ps P}")
proof(induct ps rule: length_induct)
  case (1 ps0)
  note IH = 1(1) and subset = 1(2) and dist = 1(3)
  show ?case
  proof (cases ps0)
    case Nil thus ?thesis by simp
  next
    case (Cons p ps)
    let ?ps = "deleteAround g (fst p) ps"
    have le: "|?ps|  |ps|" by(simp add:delAround_def)
    have dist': "distinct(map fst ?ps)" using dist Cons
      apply (clarsimp simp:delAround_def)
      apply(drule distinct_filter[where P = "Not  close g (fst p)"])
      apply(simp add: filter_map o_def)
      done
    have "fst p : 𝒱 g" and "fst ` set ps  𝒱 g"
      using subset Cons by auto
    have sub1: "P Q. P  {x : set ps. Q x}  fst ` P  𝒱 g"
      using subset Cons by auto
    have sub2: "P Q. P  insert p {x : set ps. Q x}  fst ` P  𝒱 g"
      using subset Cons by auto
    have sub3: "P. P  insert p (set ps)  fst ` P  𝒱 g"
      using subset Cons by auto
    have "a. set (map fst (deleteAround g a ps))  𝒱 g"
      using deleteAround_subset[of g _ ps] subset Cons
      by auto
    hence "ExcessNotAtRec ps0 g = max (Max(?M ps)) (Max(?M ?ps) + snd p)"
      using Cons IH subset le dist dist' by (cases p) simp
    also have "Max (?M ?ps) + snd p =
      Max {(pP. snd p) + snd p | P. ?S ?ps P}"
      by (auto simp add:setcompr_eq_image Max_add_commute[symmetric] sep_ne intro!: arg_cong [where f=Max])
    also have "{(pP. snd p) + snd p |P. ?S ?ps P} =
      {sum snd (insert p P) |P. ?S ?ps P}"
      using dist Cons
      apply (auto simp:delAround_def)
      apply(rule_tac x=P in exI)
      apply(fastforce intro!: sum.insert[THEN trans,symmetric] elim: finite_subset)
      apply(rule_tac x=P in exI)
      apply(fastforce intro!: sum.insert[THEN trans] elim: finite_subset)
      done
    also have " = {sum snd P |P.
            P  insert p (set ?ps)  p  P  separated g (fst ` P)}"
      apply(auto simp add:sep_conv[OF mgp] sub1 sub2 delAround_def cong: conj_cong)
      apply(rule_tac x = "insert p P" in exI)
      apply simp
      apply(rule conjI) apply blast
      using ‹image fst (set ps)  𝒱 g ‹fst p : 𝒱 g
      apply (blast intro:close_sym[OF mgp])
      apply(rule_tac x = "P-{p}" in exI)
      apply (simp add:insert_absorb)
      apply blast
      done
    also have " = {sum snd P |P.
            P  insert p (set ps)  p  P  separated g (fst ` P)}"
      using Cons dist
      apply(auto simp add:sep_conv[OF mgp] sub2 sub3 delAround_def cong: conj_cong)
      apply(rule_tac x = "P" in exI)
      apply simp
      apply auto
      done
    also have "max (Max(?M ps)) (Max ) = Max(?M ps  {sum snd P |P.
            P  insert p (set ps)  p  P  separated g (fst ` P)})"
      (is "_ = Max ?U")
    proof -
      have "{sum snd P |P.
            P  insert p (set ps)  p  P  separated g (fst ` P)}  {}"
        apply simp
        apply(rule_tac x="{p}" in exI)
        using ‹fst p : 𝒱 g by(simp add:sep_conv[OF mgp])
      thus ?thesis by(simp add: Max_Un sep_ne)
    qed
    also have "?U = ?M ps0" using Cons by simp blast
    finally show ?thesis .
  qed
qed


lemma dist_ExcessTab: "distinct (map fst (ExcessTable g (vertices g)))"
by(simp add:ExcessTable_def vertices_graph o_def)



lemma mono_ExcessTab: "g'  set (next_plane0p g); inv g  
  set(ExcessTable g (vertices g))  set(ExcessTable g' (vertices g'))"
apply(clarsimp simp:ExcessTable_def image_def)
apply(rule conjI)
 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply (clarsimp simp:ExcessAt_def split:if_split_asm)
apply(frule (3) next_plane0_finalVertex_mono)
apply(simp add: next_plane0_len_filter_eq tri_def quad_def except_def)
done


lemma close_antimono:
 "g'  set (next_plane0p g); inv g; u  𝒱 g; finalVertex g u  
  close g' u v  close g u v"
by(simp add:close_def next_plane0_finalVertex_facesAt_eq)

lemma ExcessTab_final:
 "p  set(ExcessTable g (vertices g))  finalVertex g (fst p)"
by(clarsimp simp:ExcessTable_def image_def ExcessAt_def split:if_split_asm)

lemma ExcessTab_vertex:
 "p  set(ExcessTable g (vertices g))  fst p  𝒱 g"
by(clarsimp simp:ExcessTable_def image_def ExcessAt_def split:if_split_asm)

lemma fst_set_ExcessTable_subset:
 "fst ` set (ExcessTable g (vertices g))  𝒱 g"
by(clarsimp simp:ExcessTable_def image_def ExcessAt_def split:if_split_asm)

lemma next_plane0_incr_ExcessNotAt:
 "g'  set (next_plane0p g); inv g  
  ExcessNotAt g None  ExcessNotAt g' None"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(frule (1) mono_ExcessTab)
apply(simp add: ExcessNotAt_def ExcessNotAtRec_conv_Max[OF _ _ dist_ExcessTab]
  fst_set_ExcessTable_subset)
apply(rule Max_mono)
  prefer 2 apply (simp add: sep_ne)
 prefer 2 apply (simp)
apply auto
apply(rule_tac x=P in exI)
apply auto
apply(subgoal_tac "fst ` P  𝒱 g'")
 prefer 2 apply (blast dest: ExcessTab_vertex)
apply(subgoal_tac "fst ` P  𝒱 g")
 prefer 2 apply (blast dest: ExcessTab_vertex)
apply(simp add:sep_conv)
apply (blast intro:close_antimono ExcessTab_final ExcessTab_vertex)
done
(* close -> in neibhood ?? *)


lemma next_plane0_incr_squander_lb:
 "g'  set (next_plane0p g); inv g  
  squanderLowerBound g  squanderLowerBound g'"
apply(simp add:squanderLowerBound_def)
apply(frule (1) next_plane0_incr_ExcessNotAt)
apply(clarsimp simp add:next_plane0_def split:if_split_asm)
apply(drule (4) genPoly_incr_facesquander_lb)
apply arith
done

lemma inv_notame:
 "g'  set (next_plane0p g); inv g; notame7 g
   notame7 g'"
apply(simp add:notame_def notame7_def tame11b_def is_tame13a_def tame10ub_def del:disj_not1)
apply(frule inv_mgp)
apply(frule (1) next_plane0_vertices_subset)
apply(erule disjE)
 apply(simp add:vertices_graph)
apply(rule disjI2)
apply(erule disjE)
 apply clarify
 apply(frule (2) next_plane0_incr_degree)
 apply(frule (2) next_plane0_incr_except)
 apply (force split:if_split_asm)
apply(frule (1) next_plane0_incr_squander_lb)
apply(arith)
done


lemma inv_inv_notame:
 "invariant(λg. inv g  notame7 g) next_planep"
apply(simp add:invariant_def)
apply(blast intro: inv_notame mgp_next_plane0_if_next_plane[OF inv_mgp]
       invariantE[OF inv_inv_next_plane])
done


lemma untame_notame:
 "untame (λg. inv g  notame7 g)"
proof(clarsimp simp add: notame_def notame7_def untame_def tame11b_def is_tame13a_def tame10ub_def
                         linorder_not_le linorder_not_less)
  fix g assume "final g" "inv g" "tame g"
    and cases: "15 < countVertices g 
                (v𝒱 g. (except g v = 0  7 < degree g v) 
                            (0 < except g v  6 < degree g v))
                 squanderTarget  squanderLowerBound g"
                (is "?A  ?B  ?C" is "_  (v𝒱 g. ?B' v)  _")
  from cases show False
  proof(elim disjE)
    assume ?B
    then obtain v where v: "v 𝒱 g" "?B' v" by auto
    show False
    proof cases
      assume "except g v = 0"
      thus False using ‹tame g v by(auto simp: tame_def tame11b_def)
    next
      assume "except g v  0"
      thus False using ‹tame g v
        by(auto simp: except_def filter_empty_conv tame_def tame11b_def
          minGraphProps_facesAt_eq[OF inv_mgp[OF ‹inv g]] split:if_split_asm)
    qed
  next
    assume ?A
    thus False using ‹tame g  by(simp add:tame_def tame10_def)
  next
    assume ?C
    thus False using total_weight_lowerbound[OF ‹inv g ‹final g ‹tame g]
      ‹tame g  by(force simp add:tame_def tame13a_def)
  qed
qed


lemma polysizes_tame:
 " g'  set (generatePolygon n v f g); inv g; f  set(nonFinals g);
   v  𝒱 f; 3  n; n < 4+p; n  set(polysizes p g) 
  notame7 g'"
apply(frule (4) in_next_plane0I)
apply(frule (4) genPoly_incr_facesquander_lb)
apply(frule (1) next_plane0_incr_ExcessNotAt)
apply(simp add: notame_def notame7_def is_tame13a_def faceSquanderLowerBound_def
           polysizes_def squanderLowerBound_def)
done

lemma genPolyTame_notame:
 " g'  set (generatePolygon n v f g); g'  set (generatePolygonTame n v f g);
    inv g; 3  n 
   notame7 g'"
by(fastforce simp:generatePolygon_def generatePolygonTame_def enum_enumerator
                 notame_def notame7_def)

declare upt_Suc[simp del] (* FIXME global? *)
lemma excess_notame:
 " inv g; g'  set (next_planep g); g'  set (next_tame0 p g) 
        notame7 g'"
apply(frule (1) mgp_next_plane0_if_next_plane[OF inv_mgp])
apply(auto simp add:next_tame0_def next_plane_def split:if_split_asm)
apply(rename_tac n)
apply(case_tac "n  set(polysizes p g)")
 apply(drule bspec) apply assumption
 apply(simp add:genPolyTame_notame)
apply(subgoal_tac "minimalFace (nonFinals g)  set(nonFinals g)")
 prefer 2 apply(simp add:minimalFace_def)
apply(subgoal_tac "minimalVertex g (minimalFace (nonFinals g))  𝒱(minimalFace (nonFinals g))")
 apply(blast intro:polysizes_tame)
apply(simp add:minimalVertex_def)
apply(rule minimal_in_set)
apply(erule mgp_vertices_nonempty[OF inv_mgp])
apply(simp add:nonFinals_def)
done
declare upt_Suc[simp]


lemma next_tame0_comp: " Seedp [next_plane p]→* g; final g; tame g 
  Seedp [next_tame0 p]→* g"
apply(rule filterout_untame_succs[OF inv_inv_next_plane inv_inv_notame
  untame_notame])
    apply(blast intro:excess_notame)
   apply assumption
  apply(rule inv_Seed)
 apply assumption
apply assumption
done

lemma inv_inv_next_tame0: "invariant inv (next_tame0 p)"
by(rule inv_subset[OF inv_inv_next_plane next_tame0_subset_plane])

lemma inv_inv_next_tame: "invariant inv next_tamep"
apply(simp add:next_tame_def)
apply(rule inv_subset[OF inv_inv_next_tame0])
apply auto
done

lemma mgp_TameEnum: "g  TameEnump  minGraphProps g"
by (unfold TameEnumP_def)
   (blast intro: RTranCl_inv[OF inv_inv_next_tame] inv_Seed inv_mgp)


end

Theory TameEnumProps

(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section "Properties of Tame Graph Enumeration (2)"

theory TameEnumProps
imports GeneratorProps
begin


text‹Completeness of filter for final graphs.›

lemma untame_negFin:
assumes pl: "inv g" and fin: "final g" and tame: "tame g"
shows "is_tame g"
proof (unfold is_tame_def, intro conjI)
  show "tame10 g" using tame by(auto simp:tame_def)
next
  show "tame11a g" using tame by(auto simp:tame_def)
next
  show "tame12o g" using tame by(auto simp:tame_def)
next
next
  from tame obtain w where adm: "admissible w g"
    and sqn: "(f  faces g w f) < squanderTarget" by(auto simp:tame_def tame13a_def)
  moreover have "squanderLowerBound g   (f  faces g w f)"
    using pl fin tame adm sqn by (rule total_weight_lowerbound)
  ultimately show "is_tame13a g" by(auto simp:is_tame13a_def)
qed


lemma next_tame_comp:
 " tame g; final g; Seedp [next_tame0 p]→* g 
  Seedp [next_tamep]→* g"
apply (unfold next_tame_def)
apply(rule filter_tame_succs[OF inv_inv_next_tame0])
     apply(simp add:next_tame0_def finalGraph_def)
    apply(rule context_conjI)
     apply(simp)
    apply(blast dest:untame_negFin)
   apply assumption
  apply(rule inv_Seed)
 apply assumption+
done


end

Theory Worklist

theory Worklist
imports "HOL-Library.While_Combinator" RTranCl Quasi_Order
begin

definition
  worklist_aux :: "('s  'a  'a list)  ('a  's  's)
     'a list * 's  ('a list * 's)option"
where
"worklist_aux succs f =
 while_option 
   (λ(ws,s). ws  [])
   (λ(ws,s). case ws of x#ws'  (succs s x @ ws', f x s))"

definition worklist :: "('s  'a  'a list)  ('a  's  's)
     'a list  's  's option" where
"worklist succs f ws s =
  (case worklist_aux succs f (ws,s) of
     None  None | Some(ws,s)  Some s)"

lemma worklist_aux_Nil: "worklist_aux succs f ([],s) = Some([],s)"
by(simp add: worklist_aux_def while_option_unfold)

lemma worklist_aux_Cons:
 "worklist_aux succs f (x#ws',s) = worklist_aux succs f (succs s x @ ws', f x s)"
by(simp add: worklist_aux_def while_option_unfold)

lemma worklist_aux_unfold[code]:
 "worklist_aux succs f (ws,s) =
 (case ws of []  Some([],s)
  | x#ws'  worklist_aux succs f (succs s x @ ws', f x s))"
by(simp add: worklist_aux_Nil worklist_aux_Cons split: list.split)

definition
  worklist_tree_aux :: "('a  'a list)  ('a  's  's)
     'a list * 's  ('a list * 's)option"
where
"worklist_tree_aux succs = worklist_aux (λs. succs)"

lemma worklist_tree_aux_unfold[code]:
"worklist_tree_aux succs f (ws,s) =
 (case ws of []  Some([],s) |
  x#ws'  worklist_tree_aux succs f (succs x @ ws', f x s))"
by(simp add: worklist_tree_aux_def worklist_aux_Nil worklist_aux_Cons split: list.split)


abbreviation Rel :: "('a  'a list)  ('a * 'a)set" where
"Rel f == {(x,y). y : set(f x)}"

lemma Image_Rel_set:
  "(Rel succs)* `` set(succs x) = (Rel succs)+ `` {x}"
by(auto simp add: trancl_unfold_left)

lemma RTranCl_conv:
  "g [succs]→* h  (g,h) : ((Rel succs)*)" (is "?L = ?R")
proof-
  have "?L  ?R"
    apply(erule RTranCl_induct)
    apply blast
    apply (auto elim: rtrancl_into_rtrancl)
    done
  moreover
  have "?R  ?L"
    apply(erule converse_rtrancl_induct)
    apply(rule RTranCl.refl)
    apply (auto elim: RTranCl.succs)
    done
  ultimately show ?thesis by blast
qed

lemma worklist_end_empty:
  "worklist_aux succs f (ws,s) = Some(ws',s')  ws' = []"
unfolding worklist_aux_def
by (drule while_option_stop) simp

theorem worklist_tree_aux_Some_foldl:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
shows "rs. set rs = ((Rel succs)*) `` (set ws) 
              s' = foldl (λs x. f x s) s rs"
proof -
  let ?b = "λ(ws,s). ws  []"
  let ?c = "λ(ws,s). case ws of x#ws'  (succs x @ ws', f x s)"
  let ?Q = "λws' s' done.
    s' = foldl (λx s. f s x) s done 
      ((Rel succs)*) `` (set ws) =
          set done  ((Rel succs)*) `` set ws'"
  let ?P = "λ(ws,s). done. ?Q ws s done"
  have 0: "while_option ?b ?c (ws,s) = Some(ws',s')"
    using assms by(simp add: worklist_tree_aux_def worklist_aux_def)
  from while_option_stop[OF 0] have "ws' = []" by simp
  have init: "?P (ws,s)"
    apply auto
    apply(rule_tac x = "[]" in exI)
    apply simp
    done
  { fix ws s
    assume "?P (ws,s)"
    then obtain "done" where "?Q ws s done" by blast
    assume "?b(ws,s)"
    then obtain x ws' where "ws = x # ws'" by(auto simp: neq_Nil_conv)
    then have "?Q (succs x @ ws') (f x s) (done @ [x])"
      using ?Q ws s done
      apply simp
      apply(erule thin_rl)+
      apply (auto simp add: Image_Un Image_Rel_set)
      apply (blast elim: rtranclE intro: rtrancl_into_trancl1)
      done
    hence "?P(?c(ws,s))" using ws=x#ws'
      by(simp only: split_conv list.cases) blast
  }
  then have "?P(ws',s')"
    using while_option_rule[where P="?P", OF _ 0 init]
    by auto
  then show ?thesis using ws'=[] by auto
qed

definition "worklist_tree succs f ws s =
  (case worklist_tree_aux succs f (ws,s) of
     None  None | Some(ws,s)  Some s)"

theorem worklist_tree_Some_foldl:
  "worklist_tree succs f ws s = Some s' 
   rs. set rs = ((Rel succs)*) `` (set ws) 
              s' = foldl (λs x. f x s) s rs"
by(simp add: worklist_tree_def worklist_tree_aux_Some_foldl split:option.splits prod.splits)

lemma invariant_succs:
assumes "invariant I succs"
and "xS. I x"
shows "x  (Rel succs)* `` S. I x"
proof-
  { fix x y have "(x,y) : (Rel succs)*  I x  I y"
    proof(induct rule:rtrancl_induct)
      case base thus ?case .
    next
      case step with assms(1) show ?case by(auto simp:invariant_def)
    qed
  } with assms(2) show ?thesis by blast
qed

lemma worklist_tree_aux_rule:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "invariant I succs"
and "x  set ws. I x"
and "s. P [] s s"
and "r x ws s. I x  x  set ws. I x  P ws (f x s) r  P (x#ws) s r"
shows "rs. set rs = ((Rel succs)* ) `` (set ws)  P rs s s'"
proof-
  let ?R = "(Rel succs)* `` set ws"
  from worklist_tree_aux_Some_foldl[OF assms(1)] obtain rs where
    rs: "set rs = ?R" "s' = foldl (λs x. f x s) s rs" by blast
  { fix xs have "(x  set xs. I x)  P xs s (foldl (λs x. f x s) s xs)"
    proof(induct xs arbitrary: s)
      case Nil show ?case using assms(4) by simp
    next
      case Cons thus ?case using assms(5) by simp
    qed
  }
  with invariant_succs[OF assms(2,3)] show ?thesis by (metis rs)
qed

lemma worklist_tree_aux_rule2:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "invariant I succs"
and "x  set ws. I x"
and "S s" and "x s. I x  S s  S(f x s)"
and "s. P [] s s"
and "r x ws s. I x  x  set ws. I x  S s
   P ws (f x s) r  P (x#ws) s r"
shows "rs. set rs = ((Rel succs)*) `` (set ws)  P rs s s'"
proof-
  let ?R = "(Rel succs)* `` set ws"
  from worklist_tree_aux_Some_foldl[OF assms(1)] obtain rs where
    rs: "set rs = ?R" "s' = foldl (λs x. f x s) s rs" by blast
  { fix xs have "(x  set xs. I x)  S s  P xs s (foldl (λs x. f x s) s xs)"
    proof(induct xs arbitrary: s)
      case Nil show ?case using assms(6) by simp
    next
      case Cons thus ?case using assms(5,7) by simp
    qed
  }
  with invariant_succs[OF assms(2,3)] assms(4) show ?thesis by (metis rs)
qed

lemma worklist_tree_rule:
assumes "worklist_tree succs f ws s = Some(s')"
and "invariant I succs"
and "x  set ws. I x"
and "s. P [] s s"
and "r x ws s. I x  x  set ws. I x  P ws (f x s) r  P (x#ws) s r"
shows "rs. set rs = ((Rel succs)*) `` (set ws)  P rs s s'"
proof-
  obtain ws' where "worklist_tree_aux succs f (ws,s) = Some(ws',s')" using assms(1)
    by(simp add: worklist_tree_def split: option.split_asm prod.split_asm)
  from worklist_tree_aux_rule[where P=P,OF this assms(2-5)] show ?thesis by blast
qed

lemma worklist_tree_rule2:
assumes "worklist_tree succs f ws s = Some(s')"
and "invariant I succs"
and "x  set ws. I x"
and "S s" and "x s. I x  S s  S(f x s)"
and "s. P [] s s"
and "r x ws s. I x  x  set ws. I x  S s
   P ws (f x s) r  P (x#ws) s r"
shows "rs. set rs = ((Rel succs)*) `` (set ws)  P rs s s'"
proof-
  obtain ws' where "worklist_tree_aux succs f (ws,s) = Some(ws',s')" using assms(1)
    by(simp add: worklist_tree_def split: option.split_asm prod.split_asm)
  from worklist_tree_aux_rule2[where P=P and S=S,OF this assms(2-7)]
  show ?thesis by blast
qed

lemma worklist_tree_aux_state_inv:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "I s"
and "x s. I s  I(f x s)"
shows "I s'"
proof-
  from worklist_tree_aux_rule[where P="λws s s'. I s  I s'" and I="λx. True",
    OF assms(1)] assms(2-3)
  show ?thesis by(auto simp: invariant_def)
qed

lemma worklist_tree_state_inv:
  "worklist_tree succs f ws s = Some(s')
    I s  (x s. I s  I(f x s))  I s'"
unfolding worklist_tree_def
by(auto intro: worklist_tree_aux_state_inv split: option.splits)


locale set_modulo = quasi_order +
fixes empty :: "'s"
and insert_mod :: "'a  's  's"
and set_of :: "'s  'a set"
and I :: "'a  bool"
and S :: "'s  bool"
assumes set_of_empty: "set_of empty = {}"
and set_of_insert_mod: "I x  S s  (x  set_of s. I x)
  
  set_of(insert_mod x s) = insert x (set_of s) 
  (y  set_of s. x  y)  set_of (insert_mod x s) = set_of s"
and S_empty: "S empty"
and S_insert_mod: "S s  S (insert_mod x s)"
begin

definition insert_mod2 :: "('b  bool)  ('b  'a)  'b  's  's" where
"insert_mod2 P f x s = (if P x then insert_mod (f x) s else s)"

definition "SI s = (S s  (x  set_of s. I x))"

lemma SI_empty: "SI empty"
by(simp add: SI_def S_empty set_of_empty)

lemma SI_insert_mod:
  "I x  SI s  SI (insert_mod x s)"
apply(simp add: SI_def S_insert_mod)
by (metis insertE set_of_insert_mod)

lemma SI_insert_mod2: "(x. inv0 x  I (f x)) 
  inv0 x  SI s  SI (insert_mod2 P f x s)"
by (metis insert_mod2_def SI_insert_mod)

definition worklist_tree_coll_aux ::
  "('b  'b list)  ('b  bool)  ('b  'a)  'b list  's  's option"
where
"worklist_tree_coll_aux succs P f = worklist_tree succs (insert_mod2 P f)"

definition worklist_tree_coll ::
  "('b  'b list)  ('b  bool)  ('b  'a)  'b list  's option"
where
"worklist_tree_coll succs P f ws = worklist_tree_coll_aux succs P f ws empty"

lemma worklist_tree_coll_aux_equiv:
assumes "worklist_tree_coll_aux succs P f ws s = Some s'"
and "invariant inv0 succs"
and "x  set ws. inv0 x"
and "x. inv0 x  I(f x)"
and "SI s"
shows "set_of s' =
  f ` {x : (Rel succs)* `` (set ws). P x}  set_of s"
apply(insert assms(1))
unfolding worklist_tree_coll_aux_def
apply(drule worklist_tree_rule2[where I = inv0 and S = SI and
  P = "λws s s'. SI s  set_of s' = f ` {x : set ws. P x}  set_of s",
  OF _ assms(2,3,5)])
   apply(simp add: SI_insert_mod2 assms(4))
  apply(clarsimp)
 apply(clarsimp simp add: insert_mod2_def split: if_split_asm)
  apply(frule assms(4))
  apply(frule SI_def[THEN iffD1])
  apply(frule (1) set_of_insert_mod)
  apply (simp add: SI_insert_mod)
  apply(erule disjE)
   prefer 2
   apply(rule seteq_qle_trans)
    apply assumption
   apply (simp add: "defs")
   apply blast
  apply(rule seteq_qle_trans)
   apply assumption
  apply (simp add: "defs")
  apply blast
 apply(rule seteq_qle_trans)
  apply assumption
 apply (simp add: "defs")
 apply blast
using assms(5)
apply auto
done

lemma worklist_tree_coll_equiv:
  "worklist_tree_coll succs P f ws = Some s'  invariant inv0 succs
    x  set ws. inv0 x  (x. inv0 x  I(f x))
    set_of s' = f ` {x : (Rel succs)* `` (set ws). P x}"
unfolding worklist_tree_coll_def
apply(drule (2) worklist_tree_coll_aux_equiv)
apply(auto simp: set_of_empty SI_empty)
done

lemma worklist_tree_coll_aux_subseteq:
  "worklist_tree_coll_aux succs P f ws t0 = Some t 
  invariant inv0 succs   g  set ws. inv0 g 
  (x. inv0 x  I(f x))  SI t0 
  set_of t  set_of t0  f ` {h : (Rel succs)* `` set ws. P h}"
unfolding worklist_tree_coll_aux_def
apply(drule worklist_tree_rule2[where I = inv0 and S = SI and P =
  "λws t t'. set_of t'  set_of t  f ` {g  set ws. P g}"])
      apply assumption
     apply assumption
    apply assumption
   apply(simp add: SI_insert_mod2)
  apply clarsimp
 apply (clarsimp simp: insert_mod2_def split: if_split_asm)
  using set_of_insert_mod
  apply(simp add: SI_def image_def)
  apply(blast)
 apply blast
apply blast
done

lemma worklist_tree_coll_subseteq:
  "worklist_tree_coll succs P f ws = Some t 
  invariant inv0 succs  g  set ws. inv0 g 
  (x. inv0 x  I(f x)) 
  set_of t  f ` {h : (Rel succs)* `` set ws. P h}"
unfolding worklist_tree_coll_def
apply(drule (1) worklist_tree_coll_aux_subseteq)
apply(auto simp: set_of_empty SI_empty)
done

lemma worklist_tree_coll_inv:
  "worklist_tree_coll succs P f ws = Some s  S s"
unfolding worklist_tree_coll_def worklist_tree_coll_aux_def
apply(drule worklist_tree_state_inv[where I = S])
apply (auto simp: S_empty insert_mod2_def S_insert_mod)
done

end

end

Theory Maps

theory Maps
imports Worklist Quasi_Order
begin

locale maps =
fixes empty :: "'m"
and up :: "'a  'b list  'm  'm"
and map_of :: "'m  'a  'b list"
and M :: "'m  bool"
assumes map_empty: "map_of empty = (λa. [])"
and map_up: "map_of (up a b m) = (map_of m)(a := b)"
and M_empty: "M empty"
and M_up: "M m  M (up a b m)"
begin

definition "set_of m = (UN x. set(map_of m x))"

end

locale set_mod_maps = maps empty up map_of M + quasi_order qle
for empty :: "'m"
and up :: "'a  'b list  'm  'm"
and map_of :: "'m  'a  'b list"
and M :: "'m  bool"
and qle :: "'b  'b  bool" (infix "" 60)
+
fixes subsumed :: "'b  'b  bool"
and I :: "'b  bool"
and key :: "'b  'a"
assumes equiv_iff_qle: "I x  I y  subsumed x y = (x  y)"
and "key=key"
begin

definition "insert_mod x m =
  (let k = key x; ys = map_of m k
   in if (y  set ys. subsumed x y) then m else up k (x#ys) m)"

end

sublocale
  set_mod_maps <
  set_by_maps?: set_modulo qle empty insert_mod set_of I M
proof (standard, goal_cases)
  case 1 show ?case by(simp add:set_of_def map_empty)
next
  case 2 thus ?case
    by (auto simp: Let_def insert_mod_def set_of_def map_up equiv_iff_qle
      split:if_split_asm)
next
  case 3 show ?case by(simp add: M_empty)
next
  case 4 thus ?case
    by(simp add: insert_mod_def Let_def M_up)
qed

end

Theory Arch

(* Author: Tobias Nipkow *)

section ‹Archive›

theory Arch
imports Main "HOL-Library.Code_Target_Numeral"
begin

setup fn thy =>
  let
    val T = @{typ "integer list list list"}
    val dir = Resources.master_directory thy
  in
    thy |>
    Code_Runtime.polyml_as_definition
      [(@{binding Tri'}, T), (@{binding Quad'}, T), (@{binding Pent'}, T),
       (@{binding Hex'}, T)]
      (map (Path.append dir)
        [path‹Archives/Tri.ML›, path‹Archives/Quad.ML›,
         path‹Archives/Pent.ML›, path‹Archives/Hex.ML›])
  end

text ‹The definition of these constants is only ever needed at the ML level
when running the eval proof method.›

definition Tri :: "nat list list list"
where
  "Tri = (map  map  map) nat_of_integer Tri'"

definition Quad :: "nat list list list"
where
  "Quad = (map  map  map) nat_of_integer Quad'"

definition Pent :: "nat list list list"
where
  "Pent = (map  map  map) nat_of_integer Pent'"

definition Hex :: "nat list list list"
where
  "Hex = (map  map  map) nat_of_integer Hex'"

end

Theory ArchCompAux

(*  Author: Tobias Nipkow  *)

section ‹Comparing Enumeration and Archive›

theory ArchCompAux
imports TameEnum Trie.Tries Maps Arch Worklist
begin

function qsort :: "('a  'a  bool)  'a list  'a list" where
"qsort le []       = []" |
"qsort le (x#xs) = qsort le [yxs . ¬ le x y] @ [x] @
                   qsort le [yxs . le x y]"
by pat_completeness auto
termination by (relation "measure (size  snd)")
  (auto simp add: length_filter_le [THEN le_less_trans])

definition nof_vertices :: "'a fgraph  nat" where
"nof_vertices = length  remdups  concat"

definition fgraph :: "graph  nat fgraph" where
"fgraph g = map vertices (faces g)"

definition hash :: "nat fgraph  nat list" where
  "hash fs = (let n = nof_vertices fs in
     [n, size fs] @
     qsort (λx y. y < x) (map (λi. foldl (+) 0 (map size [ffs. i  set f]))
                             [0..<n]))"
(*
definition diff2 :: "nat fgraph list ⇒ nat fgraph list
   ⇒ nat fgraph list * nat fgraph list" where
"diff2 fgs ags =
 (let tfgs = trie_of_list hash fgs;
      tags = trie_of_list hash ags in
  (filter (λfg. ¬list_ex (iso_test fg) (lookup_trie tags (hash fg))) fgs,
   filter (λag. ¬list_ex (iso_test ag) (lookup_trie tfgs (hash ag))) ags))"
*)
definition samet :: "(nat,nat fgraph) tries option  nat fgraph list  bool"
where
  "samet fgto ags = (case fgto of None  False | Some tfgs 
   let tags = tries_of_list hash ags in
   (all_tries (λfg. list_ex (iso_test fg) (lookup_tries tags (hash fg))) tfgs 
    all_tries (λag. list_ex (iso_test ag) (lookup_tries tfgs (hash ag))) tags))"

definition pre_iso_test :: "vertex fgraph  bool" where
  "pre_iso_test Fs 
   []  set Fs  (Fset Fs. distinct F)  distinct (map rotate_min Fs)"


interpretation map:
  maps "Trie None []" update_trie lookup_tries invar_trie
proof (standard, goal_cases)
  case 1 show ?case by(rule ext) simp
next
  case 2 show ?case by(rule ext) (simp add: lookup_update)
next
  case 3 show ?case by(simp)
next
  case 4 thus ?case by (simp add: invar_trie_update)
qed

lemma set_of_conv: "set_tries = maps.set_of lookup_tries"
by(rule ext) (auto simp add: set_tries_def map.set_of_def)

end

Theory ArchCompProps

(*  Author: Tobias Nipkow  *)

section "Completeness of Archive Test"

theory ArchCompProps
imports TameEnumProps ArchCompAux
begin
lemma mgp_pre_iso_test: "minGraphProps g  pre_iso_test(fgraph g)"
apply(simp add:pre_iso_test_def fgraph_def image_def)
apply(rule conjI) apply(blast dest: mgp_vertices_nonempty[symmetric])
apply(rule conjI) apply(blast intro:minGraphProps)
apply(drule minGraphProps11)
apply(simp add:normFaces_def normFace_def verticesFrom_def minVertex_def
               rotate_min_def o_def)
done

corollary iso_test_correct:
 " pre_iso_test Fs1; pre_iso_test Fs2  
  iso_test Fs1 Fs2 = (Fs1  Fs2)"
by(simp add:pre_iso_test_def iso_correct inj_on_rotate_min_iff[symmetric]
            distinct_map nof_vertices_def length_remdups_concat)

lemma trie_all_eq_set_of_trie:
  "invar_trie t  all_trie (list_all P) t = (v  set_tries t. P v)"
by(simp add: all_trie_eq_ran set_tries_eq_ran)

lemma samet_imp_iso_seteq:
assumes pre1: "gs g. gsopt = Some gs  g  set_tries gs  pre_iso_test g"
and pre2: "g. g  set arch  pre_iso_test g"
and inv: "gs. gsopt = Some gs  invar_trie gs"
and same: "samet gsopt arch"
shows "gs. gsopt = Some gs  set_tries gs = set arch"
proof -
  obtain gs where [simp]: "gsopt = Some gs" and test1: "g. g  set_tries gs 
    h  set arch. iso_test g h" and test2: "g. g  set arch 
    h  set_tries gs. iso_test g h"
    using same inv
    by(force simp: samet_def trie_all_eq_set_of_trie invar_of_list all_tries_def
      split:option.splits
      dest: in_set_lookup_of_listD in_set_lookup_set_triesD)
  have "set_tries gs  set arch"
  proof (auto simp:qle_gr.defs)
    fix g assume g: "g  set_tries gs"
    obtain h where h: "h  set arch" and test: "iso_test g h"
      using test1[OF g] by blast
    thus "hset arch. g  h"
      using h pre1[OF _ g] pre2[OF h] by (auto simp:iso_test_correct)
  qed
  moreover
  have "set arch  set_tries gs"
  proof (auto simp:qle_gr.defs)
    fix g assume g: "g  set arch"
    obtain h where h: "h  set_tries gs" and test: "iso_test g h"
      using test2[OF g] by blast
    thus "h  set_tries gs. g  h"
      using h pre1[OF _ h] pre2[OF g] by (auto simp:iso_test_correct)
  qed
  ultimately show ?thesis by (auto simp: qle_gr.seteq_qle_def)
qed

lemma samet_imp_iso_subseteq:
assumes pre1: "gs g. gsopt = Some gs  g  set_tries gs  pre_iso_test g"
and pre2: "g. g  set arch  pre_iso_test g"
and inv: "gs. gsopt = Some gs  invar_trie gs"
and same: "samet gsopt arch"
shows "gs. gsopt = Some gs  set_tries gs  set arch"
using qle_gr.seteq_qle_def assms samet_imp_iso_seteq by metis

global_interpretation set_mod_trie:
  set_mod_maps "Trie None []" update_trie lookup_tries invar_trie "(≃)" iso_test pre_iso_test hash
  defines insert_mod_trie = "set_mod_maps.insert_mod update_trie lookup_tries iso_test hash"
  and worklist_tree_coll_trie = "set_modulo.worklist_tree_coll (Trie None []) insert_mod_trie"
  and worklist_tree_coll_aux_trie = "set_modulo.worklist_tree_coll_aux insert_mod_trie"
  and insert_mod2_trie = "set_modulo.insert_mod2 insert_mod_trie"
  by standard (simp_all add: iso_test_correct)

definition enum_filter_finals ::
  "(graph  graph list)  graph list
    (nat,nat fgraph) tries option" where
"enum_filter_finals succs = set_mod_trie.worklist_tree_coll succs final fgraph"

definition tameEnumFilter :: "nat  (nat,nat fgraph)tries option" where
"tameEnumFilter p = enum_filter_finals (next_tame p) [Seed p]"

lemma TameEnum_tameEnumFilter:
  "tameEnumFilter p = Some t   set_tries t  = fgraph ` TameEnump"
apply(auto simp: tameEnumFilter_def TameEnumP_def enum_filter_finals_def)
apply(drule set_mod_trie.worklist_tree_coll_equiv[OF _ inv_inv_next_tame])
apply (auto simp: set_of_conv inv_Seed mgp_pre_iso_test RTranCl_conv)
done

lemma tameEnumFilter_subseteq_TameEnum:
  "tameEnumFilter p = Some t  set_tries t  fgraph ` TameEnump"
by(auto simp add:tameEnumFilter_def TameEnumP_def enum_filter_finals_def
     set_of_conv inv_Seed mgp_pre_iso_test RTranCl_conv
     dest!: set_mod_trie.worklist_tree_coll_subseteq[OF _ inv_inv_next_tame])


lemma inv_tries_tameEnumFilter:
  "tameEnumFilter p = Some t  invar_trie t"
unfolding tameEnumFilter_def enum_filter_finals_def
by(erule set_mod_trie.worklist_tree_coll_inv)

theorem combine_evals_filter:
 "g  set arch. pre_iso_test g  samet (tameEnumFilter p) arch
   fgraph ` TameEnump  set arch"
apply(subgoal_tac "t. tameEnumFilter p = Some t  set_tries t  set arch")
 apply(metis TameEnum_tameEnumFilter qle_gr.seteq_qle_def qle_gr.subseteq_qle_trans)
apply(fastforce intro!: samet_imp_iso_subseteq
  dest: inv_tries_tameEnumFilter tameEnumFilter_subseteq_TameEnum mgp_TameEnum mgp_pre_iso_test)
done

end

Theory Relative_Completeness

(*  Author: Tobias Nipkow  *)

section ‹Completeness Proofs under hypothetical computations›

theory Relative_Completeness
imports ArchCompProps
begin

definition Archive :: "vertex fgraph set" where
"Archive  set(Tri @ Quad @ Pent @ Hex)"

locale archive_by_computation =
  assumes pre_iso_test3: "g  set Tri. pre_iso_test g"
  assumes pre_iso_test4: "g  set Quad. pre_iso_test g"
  assumes pre_iso_test5: "g  set Pent. pre_iso_test g"
  assumes pre_iso_test6: "g  set Hex. pre_iso_test g"
  assumes same3: "samet (tameEnumFilter 0) Tri"
  assumes same4: "samet (tameEnumFilter 1) Quad"
  assumes same5: "samet (tameEnumFilter 2) Pent"
  assumes same6: "samet (tameEnumFilter 3) Hex"
begin

theorem TameEnum_Archive:  "fgraph ` TameEnum  Archive"
using combine_evals_filter[OF pre_iso_test3 same3]
      combine_evals_filter[OF pre_iso_test4 same4]
      combine_evals_filter[OF pre_iso_test5 same5]
      combine_evals_filter[OF pre_iso_test6 same6]
by(fastforce simp:TameEnum_def Archive_def image_def qle_gr.defs
       eval_nat_numeral le_Suc_eq)

lemma TameEnum_comp:
assumes "Seedp [next_planep]→* g" and "final g" and "tame g"
shows "Seedp [next_tamep]→* g"
proof -
  from assms have "Seedp [next_tame0 p]→* g" by(rule next_tame0_comp)
  with assms show "Seedp [next_tamep]→* g" by(blast intro: next_tame_comp)
qed

(* final not necessary but slightly simpler because of lemmas *)
lemma tame5:
assumes g: "Seedp [next_plane0p]→* g" and "final g" and "tame g"
shows "p  3"
proof -
  from ‹tame g have bound: "f   g. |vertices f|  6"
    by (simp add: tame_def tame9a_def)
  show "p  3"
  proof (rule ccontr)
    assume 6: "¬ p  3"
    obtain f where "f  set (finals g)  |vertices f| = p+3"
      using max_face_ex[OF g] by auto
    also from ‹final g have "set (finals g) = set (faces g)" by simp
    finally have "f   g  6 < |vertices f|" using 6 by arith
    with bound show False by auto
  qed
qed

theorem completeness:
assumes "g  PlaneGraphs" and "tame g" shows "fgraph g  Archive"
proof -
  from g  PlaneGraphs› obtain p where g1: "Seedp [next_planep]→* g"
    and "final g"
    by(auto simp:PlaneGraphs_def PlaneGraphsP_def)
  have "Seedp [next_plane0p]→* g"
    by(rule RTranCl_subset2[OF g1])
      (blast intro:inv_mgp inv_Seed mgp_next_plane0_if_next_plane
        dest:RTranCl_inv[OF inv_inv_next_plane])
  with ‹tame g ‹final g have "p  3" by(blast intro:tame5)
  with g1 ‹tame g ‹final g show ?thesis using TameEnum_Archive
    by(simp add: qle_gr.defs TameEnum_def TameEnumP_def)
      (blast intro: TameEnum_comp)
qed

end

end